COMMENT ⊗   VALID 00047 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	   -*-MIDAS-*-
C00005 00003
C00009 00004
C00012 00005
C00015 00006
C00018 00007
C00020 00008
C00023 00009
C00024 00010
C00027 00011
C00029 00012
C00033 00013
C00035 00014
C00038 00015
C00039 00016
C00042 00017
C00044 00018
C00047 00019
C00050 00020
C00053 00021
C00059 00022
C00062 00023
C00064 00024
C00067 00025
C00069 00026
C00073 00027
C00077 00028
C00083 00029
C00086 00030
C00089 00031
C00093 00032
C00096 00033
C00099 00034
C00103 00035
C00105 00036
C00109 00037
C00112 00038
C00114 00039
C00119 00040
C00123 00041
C00126 00042
C00129 00043
C00132 00044
C00135 00045
C00137 00046
C00139 00047
C00141 ENDMK
C⊗;
;;;   -*-MIDAS-*-
;;;   **************************************************************
;;;   ***** MACLISP ****** GARBAGE COLLECTOR AND ALLOCATION STUFF **
;;;   **************************************************************
;;;   ** (C) COPYRIGHT 1981 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
;;;   ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
;;;   **************************************************************




	PGBOT GC


SUBTTL	GRABBAGE COLLECTORS AND RELATED ITEMS


GCRET:	TDZA A,A	;GC WITH NORET=NIL
GCNRT:	MOVEI A,TRUTH	;GC WITH NORET=T
	HRRI T,UNBIND	;EXPECTS FLAG IN LH OF T
	PUSH P,T
	JSP T,SPECBIND
	0 A,VNORET
	JRST AGC


GC:	PUSH P,[333333,,FALSE]	;SUBR 0 - USER ENTRY TO GC
	JRST AGC		;TO UNDERSTAND THE 3'S, SEE GSTRT7


MINCEL==6*NFF	;MIN NUMBER WORDS TO RECLAIM FOR EACH SPACE
IFG 40-MINCEL, MINCEL==40

GCCNT:				;FREELIST COUNTING LOOP TO RUN IN AC'S
OFFSET -.
	NIL			;SO THAT THE FOLLOWING INS WILL STOP ON NIL
GCCNT1:	SKIPE TT,(TT)
GCCNT4:	 AOJA GCCNT0,.-1	;OR MAYBE AOBJN
	JRST GCP4A
LPROG3==:.-1
GCCNT0:
OFFSET 0
.HKILL GCCNT1 GCCNT4 GCCNT0

SUBTTL	GC - INITIALIZATION

WHL==:USELESS*ITS		;FLAG FOR WHO-LINE STUFF

   XCTPRO
AGC4:	HRROS NOQUIT		;ENTRY FROM FWCONS, FLCONS, AND THE LIKE
   NOPRO
	SUBI A,2		;ENTER WITH  JSP A,AGC4
	PUSH P,A
   XCTPRO
AGC:	HRROS NOQUIT		;ENTER HERE WITH  PUSHJ P,AGC
   NOPRO
	SKIPE ALGCF		;CANT SUCCESSFULLY GC WHILE IN ALLOC
	 JRST ALERR
AGC1:
;MUST HAVE DONE  HRROS NOQUIT  BEFORE COMING HERE.
;FIRST WE GET CURRENT RUNTIME IN "HOST MACHINE UNITS" IN GCTM1.
;THIS MUST BE DONE IN AND AROUND THE SAVING OF THE AC'S.
IT$	.SUSET [.RRUNT,,GCTM1]
	MOVEM NACS+1,GCNASV
10$	SETZ NACS+1,
10$	RUNTIM NACS+1,		;GET RUNTIME FOR THIS JOB
10$	MOVEM NACS+1,GCTM1
	MOVEI NACS+1,GCACSAV
	BLT NACS+1,GCACSAV+NACS	;BLT AWAY ARG ACS (AND NIL) INTO PROTECTED PLACE
20$	MOVEI 1,.FHSLF
20$	RUNTM			;GET RUNTIME FOR THIS FORK
20$	MOVEM 1,GCTM1
	MOVE NACS+1,[NACS+2,,GCNASV+1]
	BLT NACS+1,GCNASV+16-<NACS+1>	;SAVE NON-MARKED AC'S EXCEPT SP
	MOVE NACS+1,[UUOH,,GCUUSV]
	BLT NACS+1,GCUUSV+LUUSV-1	;SAVE UUOH STUFF, IN CASE STRT IS USED
	MOVEI A,TRUTH			;SPECBIND TERPRI TO T, TO PREVENT
	JSP T,SPECBIND			; AUTO-TERPRI IN GC MESSAGES
	   0 A,V%TERPRI
	MOVEM SP,GCNASV+17-<NACS+1>	;NOW SAVE SP
	SETZM GCFXP
	SETZ R,
REPEAT NFF,[
	SKIPN FFS+.RPCNT	;FIGURE OUT WHICH SPACE(S) EMPTY
	 TLO R,400000←-.RPCNT
]		;END OF REPEAT NFF
	SKIPN FFY2			;IF WE RAN OUT OF SYMBOL BLOCKS,
	 TLO R,400000←<-FFY+FFS>	; THEN CREDIT IT TO SYMBOLS
	MOVN D,R		;THIS IS A STANDARD HACK TO KILL ONE BIT
	TDZE R,D		;SKIP IF THERE WERE NO BITS
	 JUMPE R,GCGRAB		;JUMP IF EXACTLY ONE BIT ON
AGC1Q:	SETZM GCRMV
	AOSE IRMVF	;IF OVERRIDE IS ON, THEN
	 SKIPE VGCTWA
	  SETOM GCRMV		;DO REMOVAL ANYHOW.
	MOVNI TT,20		;TOP 40 BITS OF WORD ON
	JSP F,GCINBT		;INIT MARK BITS FOR LIST, FIXNUM, ETC.
	MOVE T,[SFSSIZ,,OFSSIZ]	;SAVE AWAY OLD SIZES OF SPACES
	BLT T,OSASIZ		; (USED FOR ARG TO GC-DAEMON)
	MOVE T,VGCDAEMON
	IOR T,GCGAGV
IFE WHL,	JUMPE T,GCP6
IFN WHL,	JUMPE T,GCP5
	MOVSI R,GCCNT
	BLT R,LPROG3
	SKIPN VGCDAEMON
	HRLI GCCNT4,(AOBJN GCCNT0,)
	MOVNI R,NFF		;MAY OR MAY NOT HAVE BIGNUMS OR HUNKS
GCP4:	SETZ GCCNT0,
	SKIPGE FFS+NFF(R)
	 JRST GCP4B
	SKIPN VGCDAEMON
	 MOVSI GCCNT0,-MINCEL
	SKIPE TT,FFS+NFF(R)
	 AOJA GCCNT0,GCCNT1
GCP4A:	TLZ GCCNT0,-1
	HRRZ F,GCWORN+NFF(R)	;ACCOUNT FOR LENGTHS OF ITEMS
	IMULI GCCNT0,(F)
	CAIGE GCCNT0,MINCEL	;IF LESS THEN MINCEL, THEN FREELIST WAS
	 SETZM FFS+NFF(R)	; "PRACTICALLY EMPTY" AND DESERVES SOME BLAME
GCP4B:	HRLM GCCNT0,NFFS+NFF(R)
	AOJL R,GCP4

;FALLS THROUGH

;FALLS IN

;;;	PDLS ARE SAFE

IFN WHL,[
GCP5:	MOVE F,GCWHO
	SKIPE GCGAGV
	 JRST GSTRT0
	TRNN F,1		;1-BIT MEANS WE WANT TO SEE
	 JRST GCP6		; THE REASON FOR THE GC
	JRST GSTR0A		; IN THE WHO-LINE
]		;END OF IFN WHL
IFE WHL,[
	SKIPN GCGAGV
	 JRST GCP6
]		;END OF IFE WHL
GSTRT0:	STRT 17,[SIXBIT \↑M;GC DUE TO !\]
GSTR0A:	SETZB TT,D		;FIGURE OUT REASON FOR GC
	HLRZ T,(P)
	CAIN T,111111		;WAS IT INITIAL STARTUP? (SEE LISP)
	 MOVEI TT,[SIXBIT \STARTUP!\]
	CAIN T,333333		;WAS IT USER CALLING GC FUNCTION?
	 MOVEI TT,[SIXBIT \USER!\]
	CAIN T,444444		;WAS IT ARRAYS?
	 MOVEI TT,[SIXBIT \ARRAY RELOCATION!\]
	CAIN T,555555		;I/O CHANNELS?
	 MOVEI TT,[SIXBIT \I/O CHANNELS!\]
	CAIN T,666666		;SUSPEND?
	 MOVEI TT,[SIXBIT \SUSPEND!\]
	JUMPN TT,GSTRT8
	MOVNI T,NFF		;NONE OF THOSE HYPOTHESES WORK
GSTRT1:	SKIPN FFS+NFF(T)	;MAYBE SOME STORAGE SPACE RAN OUT
	 SKIPA TT,T
	  ADDI D,1
	AOJL T,GSTRT1
	JUMPE TT,GSTRT7		;NO, THAT WASN'T IT
IFN WHL,	SKIPN GCGAGV
.ALSO,		 JRST GSTRT4
	MOVNI T,NFF		;YES, IT WAS. PRINT MOBY MESSAGE!
	SETZ R,
GSTRT2:	SKIPE FFS+NFF(T)
	 JRST GSTRT5
	JUMPE R,GSTRT3
	CAIE D,NFF-2
	 STRT 17,[SIXBIT \, !\]
	CAMN T,TT
	 STRT 17,[SIXBIT \ AND !\]
GSTRT3:	SETO R,
	STRT 17,@GSTRT9+NFF(T)
GSTRT5:	AOJL T,GSTRT2
	STRT 17,[SIXBIT \ SPACE!\]
	CAIE D,NFF-1
	 STRT 17,[SIXBIT \S!\]
IFN WHL, GSTRT4:	MOVE TT,GSTRT9+NFF(TT)
	JRST GSTRT6


GSTRT7:	MOVEI TT,[SIXBIT \ ? !\]	;I DON'T KNOW WHY WE'RE HERE!
GSTRT8:
IFN WHL,SKIPE GCGAGV
	STRT 17,(TT)		;PRINT REASON

GSTRT6:
IFN WHL,[
	TRNN F,1
	 JRST GCWHL9
	MOVE D,(TT)
	MOVE R,1(TT)
	ROTC D,-22
	MOVSI F,(SIXBIT \!\)
	MOVE T,[220600,,D]
GCWHL2:	ILDB TT,T
	CAIE TT,'!
	 JRST GCWHL2
	DPB NIL,T
GCWHL3:	IDPB NIL,T
	TLNE T,770000
	 JRST GCWHL3
	HRLI D,(SIXBIT \GC:\)
	MOVE T,[-6,,GCWHL6]
	.SUSET T
GCWHL9:
]		;END OF IFN WHL

;FALLS THROUGH

;;;	 PDLS ARE SAFE

SUBTTL	GC - MARK THE WORLD

;FALLS IN

GCP6:	HRROS MUNGP		;STARTING TO MUNG SYMBOL/SAR MARK BITS
	MOVE A,[<-20>←-NUNMRK]	;PRE-PROTECT CERTAIN
	ANDM A,BTBLKS		; RANDOM LIST CELLS
	MOVNI R,NACS+1		;PROTECT CONTENTS OF MARKED ACS
GCP6Q0:	HRRZ A,GCACSAV+NACS+1(R)
	JSP T,GCMARK
	AOJL R,GCP6Q0
	HRRZ R,C2
	ADDI R,1
GCP6Q1:	HRRZ A,(R)		;CAUSES MARKING OF CONTENTS
	JSP T,GCMARK		; OF ACS AT TIME OF GC, AND OF REG PDL
	CAIGE R,(P)
	 AOJA R,GCP6Q1
	MOVEI R,LPROTE-1
GCP6Q2:	MOVEI A,BPROTE(R)	;PROTECT PRECIOUS STUFF
	JSP T,GCMARK
	SOJGE R,GCP6Q2
IFN BIGNUM,[
	MOVEI R,LBIGPRO-1
GCP6Q3:	MOVEI A,BBIGPRO(R)
	JSP T,GCMARK
	SOJGE R,GCP6Q3
]		;END OF IFN BIGNUM
	MOVSI R,TTS<GC>
	IORM R,DEDSAR+TTSAR	;PROTECT DEDSAR
	IORM R,DBM+TTSAR	;PROTECT DEAD BLOCK MARKER
	HRRZ R,SC2
GCP6Q4:	HRRZ A,(R)
	JSP T,GCMARK		;MARK SAVED VALUES ON SPEC PDL
	CAIGE R,(SP)
	 AOJA R,GCP6Q4
	SKIPN R,INTAR
	 JRST GCP6Q6
GCP6Q5:	MOVE A,INTAR(R)
	JSP T,GCMARK
	SOJG R,GCP6Q5
GCP6Q6:				;PROTECT INTERRUPT FUNCTIONS
IRP Z,,[0,1,2]X,,[ALARMCLOCK,AUTFN,UDF]
	MOVEI R,NUINT!Z
	SKIPE A,V!X(R)
	 JSP T,GCMARK
	SOJG R,.-2
TERMIN
	SKIPE A,VMERR
	 JSP T,GCMARK
IFN PAGING,[
	SKIPN D,LHSGLK		;SKIP IF ANY LH SEGMENTS
	 JRST GCP6R0		.SEE LHVBAR
GCP6Q8:	MOVEI F,(D)		;CREATE AOBJN POINTER INTO SEGMENT
	LSH F,SEGLOG
	HRLI F,-SEGSIZ
GCP6Q9:	HLRZ A,(F)		;MARK FROM ALL ENTRIES IN THAT SEGMENT
	JSP T,GCMARK
	HRRZ A,(F)
	JSP T,GCMARK
	AOBJN F,GCP6Q9
	LDB D,[SEGBYT,,GCST(D)]	;FOLLOW LINKED LIST OF SEGMENTS
	JUMPN D,GCP6Q8
GCP6R0:
]		;END OF IFN PAGING

;FALLS THROUGH

;;;	PDLS ARE SAFE

;FALLS IN

	SKIPN GCRMV
	 JRST GCP6B1
	JSP R,GCGEN		;IF DOING TWA REMOVAL, TRY MARKING FROM 
		GCP8I		;NON-TRIVIAL P-LISTS OF CURRENT OBARRAY
	JRST GCP6B2

GCP6B1:	MOVE A,VOBARRAY
	JSP TT,$GCMKAR		;OTHERWISE, JUST MARK OBARRAY BUCKETS
GCP6B2:	MOVEI A,OBARRAY
	CAME A,VOBARRAY
	 JSP TT,$GCMKAR
	MOVE R,GCMKL
GCP6A:	JUMPE R,GCP6D
	HLRZ A,(R)
	MOVE D,ASAR(A)
	TLNN D,AS<GCP>	;IF ARRAY POINTER HAS "GC ME" BIT SET,
	 JRST GCP6F
	TLNE D,AS<OBA>	;MORE CHECKING ON OBARRAYS
	 JRST GCP6F0
GCP6F1:	JSP TT,GCMKAR	; THEN MARK FROM ARRAY ENTRIES
GCP6F:	HRRZ R,(R)
	HRRZ R,(R)
	JRST GCP6A

GCP6F0:	CAMN A,VOBARRAY	; AND IF THIS ISN'T THE CURRENT OBARRAY,
	 SKIPN GCRMV	; OR IT IS, BUT WE ARENT DOING GCTWA REMOVAL,
	  JRST GCP6F1
	JRST GCP6F

GCP6D:	MOVE A,V%TYI
	JSP TT,$GCMKAR
	MOVE A,V%TYO
	JSP TT,$GCMKAR
 	SKIPN R,PROLIS
GCP6D1:	 JUMPE R,GCP6H	;PROTECT READ-MACRO
	HLRZ A,(R)	; FUNCTIONS (CAN'T JUST GCMARK WHOLE
	HLRZ A,(A)	; PROLIS - DON'T WANT TO PROTECT
	JSP T,GCMARK	; READTABLE SARS)
	HRRZ R,(R)
	JRST GCP6D1


GSTRT9:	[SIXBIT \LIST!\]	.SEE GCWORRY
	[SIXBIT \FIXNUM!\]	.SEE GCPNT
	[SIXBIT \FLONUM!\]
DB$	[SIXBIT \DOUBLE!\]
CX$	[SIXBIT \COMPLEX!\]
DX$	[SIXBIT \DUPLEX!\]
BG$	[SIXBIT \BIGNUM!\]
	[SIXBIT \SYMBOL!\]
IRP X,,[2,4,8,16,32,64,128,256,512,1024]
	[SIXBIT \HUNK!X!!\]
IFE .IRPCNT-HNKLOG, .ISTOP
TERMIN
	[SIXBIT \ARRAY!\]

IFN WHL,[
GCWHL6:	.RWHO1,,GCWHO1
	.RWHO2,,GCWHO2
	.RWHO3,,GCWHO3
	.SWHO1,,[.BYTE 8 ? 66 ? 0 ? 366 ? 0 ? .BYTE]
	.SWHO2,,D
	.SWHO3,,R
]		;IFN WHL

;;;	PDLS ARE SAFE

SUBTTL	GC - CONSIDER THE EFFECTS OF AN ARRAY DISAPPEARING

;;; UPDATE THE GCMKL BY SPLICING OUT ARRAYS TO BE SWEPT.
;;; IF ANY SUCH ARRAYS ARE OPEN FILES, CLOSE THEM.

CGCMKL:
GCP6H:	SKIPN F,GCMKL
	JRST GCP7
	JSP A,GCP6H0
GCP6H1:	HLRZ A,(F)
	TDNE TT,TTSAR(A)
	JRST GCP6G
	TDNE T,ASAR(A)
	JRST GCP6H7
GCP6H8:
	ANDCAM TT,TTSAR(A)
	IORM R,TTSAR(A)
	MOVEI B,ADEAD
	EXCH B,ASAR(A)
	TLNN B,AS<RDT>
	JRST GCP6G
	MOVEI AR1,PROLIS	;JUST KILLED A READTABLE
GCP6H3:	HRRZ AR2A,(AR1)		; - CLEAN UP PROLIS
GCP6H4:	JUMPE AR2A,GCP6G
	HLRZ C,(AR2A)
	HRRZ C,(C)
	HLRZ C,(C)
	CAIE C,(A)
	JRST GCP6H5
	HRRZ AR2A,(AR2A)
	HRRM AR2A,(AR1)
	JRST GCP6H4
GCP6H5:	MOVEI AR1,(AR2A)
	JRST GCP6H3
GCP6G:	HRRZ F,(F)
	HRRZ F,(F)
	JUMPN F,GCP6H1
	JRST GCP7

GCP6H0:	MOVSI T,AS<JOB+FIL>	;SET UP SOME ACS FOR THE GCMKL-LOOK LOOP
	MOVE R,[TTDEAD]
	MOVSI TT,TTS<CN+GC>
	JRST (A)

;;;	PDLS ARE SAFE


;;; CLEAN UP AND CLOSE A FILE WHEN GARBAGE COLLECTED

GCP6H7:	MOVE B,TTSAR(A)		;ABOUT TO GC A FILE ARRAY
	TLNE B,TTS<CL>		;IGNORE IF ALREADY CLOSED
	 JRST GCP6H8
	PUSH P,F
IFN JOBQIO,[
	HLL B,ASAR(A)
	TLNE B,AS<JOB>
	 JRST GCP6J1
]		;END OF IFN JOBQIO
	PUSHJ P,ICLOSE		;OTHERWISE CLOSE THE FILE
	MOVEI R,[SIXBIT \↑M;FILE CLOSED: !\]
GCP6H2:	SKIPN GCGAGV
	 JRST GCP6H9
	STRT 17,(R)
	HLRZ A,@(P)
	HRRZ AR1,VMSGFILES
	TLO AR1,200000
	HRROI R,$TYO
	PUSHJ P,PRINTA
GCP6H9:	POP P,F
	JSP A,GCP6H0		;RE-INIT MAGIC CONSTANTS IN ACS
	HLRZ A,(F)
	JRST GCP6H8



IFN JOBQIO,[

;;; CLEAN UP AND CLOSE AN INFERIOR PROCEDURE WHEN GARBAGE COLLECTED

GCP6J1:
IFN ITS,[
	MOVEI R,[SIXBIT \↑M;FOREIGN JOB FLUSHED: !\]
	SKIPN T,J.INTB(B)
	 JRST GCP6J3
	MOVEI R,[SIXBIT \↑M;INFERIOR JOB FLUSHED: !\]
	.CALL GCP6J9		;IF INFERIOR JOB, OPEN IT ON
	 .VALUE			; THE TEMPORARY I/O CHANNEL
	JFFO T,.+1
	MOVNS TT
	SETZM JOBTB+21(TT)	;CLEAR ENTRY IN JOB TABLE
]		;END OF IFN ITS
GCP6J3:	MOVSI T,TTS<CL>		;MARK THE JOB OBJECT AS BEING CLOSED
	ANDCAM T,TTSAR(A)
	JRST GCP6H2

IFN ITS,[
GCP6J9:	SETZ
	SIXBIT \OPEN\		;OPEN FILE (INFERIOR PROCEDURE)
	  1000,,TMPC		;CHANNEL NUMBER
	      ,,F.DEV(B)	;DEVICE NAME (USR)
	      ,,F.FN1(B)	;FILE NAME 1 (UNAME)
	400000,,F.FN2(B)	;FILE NAME 2 (JNAME)
]		;END OF IFN ITS

]		;END OF IFN JOBQIO


;;;	PDLS ARE SAFE

SUBTTL	GC - TWA REMOVAL

GCP7:	HRRZ A,GCMKL
	JSP T,GCMARK
	HRRZ A,PROLIS
	JSP T,GCMARK
	SKIPN GCRMV
	JRST GCSWP
	JSP R,GCGEN		;IF DOING TWA REMOVAL, THEN WIPE OUT
	   GCP8G		; T.W.A.'S AND THEN MARK BUCKETS
	MOVE A,VOBARRAY
	JSP TT,$GCMKAR

;FALLS THROUGH

;;;	PDLS ARE UNSAFE

SUBTTL	GC - SWEEP THE WORLD

;FALLS IN

GCSWP:				.SEE KLINIT ;WHICH CLOBBERS NEXT INSTRUCTION
	MOVEM FXP,GCFXP		;WE ARE ABOUT TO CLOBBER THE PDL POINTERS
	MOVNI SP,NFF		;NUMBER OF SPACES TO SWEEP
	MOVEM SP,GC99
;MAJOR SWEEP LOOP OVER ALL SPACES
GCSW1:	MOVE FXP,GCSWTB+NFF(SP)	;PUT INNER SWEEP LOOP IN AC'S
	HLLZ FLP,FXP		; AND INITIALIZE COUNT
	BLT FLP,(FXP)
	SETZ FXP,		;FXP HAS FREELIST, A HAS COUNT
	SKIPN FLP,FSSGLK+NFF(SP)
	 JRST GCSW7
;MINOR SWEEP LOOP OVER ALL SEGMENTS IN A SPACE
GCSW2:	MOVEM FLP,GC98
	JRST @GCSW2A+NFF(SP)	;DISPATCH ON TYPE TO SEPARATE ROUTINES
GCSW2A:	GCSWS			;LIST
	GCSWS			;FIXNUM
	GCSWS			;FLONUM
DB$	GCSWD			;DOUBLE
CX$	GCSWC			;COMPLEX
DX$	GCSWZ			;DUPLEX
BG$	GCSWS			;BIGNUM
	GCSWY			;SYMBOL
IFN HNKLOG, 	GCSWH1
REPEAT HNKLOG,[
IFL .RPCNT-4,	GCSWH1		;HUNKS OF LESS THAN 40 WORDS
.ELSE		GCSWH2		;HUNKS OF 40 WORDS OR MORE
]		;END OF REPEAT HNKLOG
	GCSWA			;SARS
IFN .-GCSW2A-NFF, WARN [WRONG LENGTH TABLE]

GCSW5:	MOVE SP,GC99
	MOVE FLP,GC98
	LDB FLP,[SEGBYT,,GCST(FLP)]
	JUMPN FLP,GCSW2
GCSW7:
	HRRZ A,@GCSW7A+NFF(SP)
	HRRM FXP,FFS+NFF(SP)	;SAVE FREELIST - DON'T DISTURB SIGN BIT
	HRRZ B,GCWORN+NFF(SP)
	IMULI A,(B)		;ACCOUNT FOR SIZE OF OBJECTS IN THIS SPACE
	HRRM A,NFFS+NFF(SP)	;SAVE COUNT OF WORDS COLLECTED
	AOSGE SP,GC99
	 JRST GCSW1
	HRRZS MUNGP		;WE HAVE UNDONE MUNGING OF BITS
	MOVSI F,TTS<CN+GC>
	ANDCAM F,DEDSAR		;MUST CLEAR BITS IN DEDSAR
	JSP NACS+1,GCACRS	;RESTORE ACCUMULATORS
	JRST GCPNT		;NEXT PRINT STATISTICS

;;;	PDLS ARE UNSAFE

;TABLE OF SWEEPERS FOR RUNNING IN ACS AND THE LAST LOCATIONS TO LOAD THEM INTO
GCSWTB:	GCFSSWP,,LPROG1		;LIST
	GCFSSWP,,LPROG1		;FIXNUM
	GCFSSWP,,LPROG1		;FLONUM
DB$	GCHSW1,,LPROGH		;DOUBLE
CX$	GCHSW1,,LPROGH		;COMPLEX
DX$	GCHSW1,,LPROGH		;DUPLEX
BG$	GCFSSWP,,LPROG1		;BIGNUM
	GSYMSWP,,LPROG6		;SYMBOL
IFN HNKLOG,	GCHSW1,,LPROGH	
REPEAT HNKLOG,[
IFL .RPCNT-4,	GCHSW1,,LPROGH	;HUNKS OF LESS THAN 40 WORDS
.ELSE		GCHSW2,,LPROGK	;HUNKS OF 40 WORDS OR MORE
]		;END OF REPEAT HNKLOG
	GSARSWP,,LPROG4		;SARS
IFN .-GCSWTB-NFF, WARN [WRONG LENGTH TABLE]

;TABLE OF AC FOR EACH SWEEPER WHICH HOLDS COUNT OF OBJECTS SWEPT
GCSW7A:	GFSCNT			;LIST
	GFSCNT			;FIXNUM
	GFSCNT			;FLONUM
DB$	GHCNT1			;DOUBLE
CX$	GHCNT1			;COMPLEX
DX$	GHCNT1			;DUPLEX
BG$	GFSCNT			;BIGNUM
	GYCNT			;SYMBOL
IFN HNKLOG,	GHCNT1	
REPEAT HNKLOG,[
IFL .RPCNT-4,	GHCNT1		;HUNK OF LESS THAN 40 WORDS
.ELSE		GHCNT2		;HUNKS OF 40 WORDS OR MORE
]		;END OF REPEAT HNKLOG
	GSCNT			;SARS
IFN .-GCSW7A-NFF, WARN [WRONG LENGTH TABLE]


;;;	PDLS ARE UNSAFE

GCSWS:	MOVE P,GCST(FLP)	;GET SHIFTED ADDRESS OF BIT BLOCK
	LSH P,SEGLOG-5		;SHIFT BACK TO FORM WORD ADDRESS
	HRLI P,-BTBSIZ		;MAKE AOBJN POINTER OVER WORDS OF BITS
	LSH FLP,SEGLOG
	HRLI FLP,-40		;40 CELLS PER WORD OF BITS
	JRST GFSP1
;FXP HAS RUNNING FREELIST
;FLP HAS AOBJN POINTER OVER CELLS
;P HAS AOBJN POINTER OVER WORDS OF BITS
GCFSSWP:			;SWEEPER FOR LIST, FIXNUM, FLONUM, BIGNUM
OFFSET -.
GFSP1:	SKIPN SP,(P)		;GET A WORD OF MARK BITS
	 JRST GFSP5		;IF ALL 40 WORDS MARKED, THIS SAVES TIME
GFSP2:	JUMPGE SP,GFSP4		;JUMP IF SINGLE WORD MARKED
	HRRZM FXP,(FLP)		;ELSE CHAIN INTO FREE LIST
	HRRZI FXP,(FLP)
GFSCNT:	AOJ .,0			;RH COUNTS RECLAIMED CELLS
GFSP4:	ROT SP,1		;ROTATE NEXT MARK BIT UP
	AOBJN FLP,GFSP2		;COUNT OFF 40 WORDS
	TLOA FLP,-40		;RESET 40-WORD COUNT IN AOBJN POINTER
GFSP5:	 ADDI FLP,40		;SKIP OVER 40 WORDS IN SWEEP
	AOBJN P,GFSP1		;<BTBSIZ> BLOCKS OF 40 WORDS
	JRST GCSW5
LPROG1==:.-1
OFFSET 0
.HKILL GFSP1 GFSP2 GFSCNT GFSP4 GFSP5


GCSWY:	LSH FLP,SEGLOG
	HRLI FLP,-SEGSIZ
	JRST GYSP1
GSYMSWP:			;SWEEPER FOR SYMBOL SPACE
OFFSET -.
GYSP7:	(300,,0)	;3.8=PURE, 3.7=COMPILED CODE REFS (NOTE: TSNE WITH ITSELF ALWAYS SKIPS)
GYSP1:	HLRZ SP,(FLP)
	TRZN SP,1		;IF MARKED,
	 TSNE GYSP7,(SP)	; OR IF PURE OR COMPILED CODE NEEDS IT,
	  JRST GYSP3		; THEN DO NOT SWEEP UP
	JUMPN SP,GYSP5		;IF NON-NIL LEFT HALF, RECLAIM THE SYMBOL BLOCK
GYSP2:	HRRZM FXP,(FLP)		;CHAIN ONTO FREELIST
	HRRZI FXP,(FLP)
GYCNT:	AOJ .,0
GYSP3:	HRLM SP,(FLP)
	AOBJN FLP,GYSP1
	JRST GCSW5
LPROG6==:.-1
OFFSET 0
.HKILL GYSP1 GYSP2 GYSP3 GYSP7 GYCNT

;;; PART OF SYMBOL SWEEPER - RESTORES A SYMBOL BLOCK TO FFY2.
;;; ALSO ATTEMPTS TO RETURN THE VALUE CELL IF IT HAS ONE.

GYSP5:	EXCH SP,FFY2		;RETURN SYMBOL BLOCK TO FREELIST
	EXCH SP,@FFY2
	TLZ SP,-1		;MAYBE TRY TO RETURN A VALUE CELL
	CAIE SP,SUNBOUND
	 JRST GYSP5A
	SETZ SP,
	JRST GYSP2

GYSP5A:	CAIL SP,BXVCSG+NXVCSG*SEGSIZ
	 JRST GYSP5B		;CAN ONLY RETURN CELLS IN VC SPACE
	EXCH SP,FFVC
	MOVEM SP,@FFVC
GYSP5B:	SETZ SP,
	JRST GYSP2

;;;	PDLS ARE UNSAFE

IFN HNKLOG+DBFLAG+CXFLAG,[

GCSWD:
GCSWC:
GCSWZ:
GCSWH1:	HRRZ P,GCWORN+NFF(SP)	;GET SIZE OF OBJECTS
	HRRI GH1SP4,(P)
	SUBI P,1
	HRRI GH1SP5,(P)
	HRRZ P,GCWORN+NFF(SP)
	MOVNI SP,40
	IDIVM SP,P
	HRRI GH1SP6,(P)		;BITS PER BIT BLOCK WORD
	MOVE P,GCST(FLP)	;GET SHIFTED ADDRESS OF BIT BLOCK
	LSH P,SEGLOG-5		;SHIFT BACK TO FORM WORD ADDRESS
	HRLI P,-BTBSIZ		;MAKE AOBJN POINTER OVER WORDS OF BITS
	LSH FLP,SEGLOG		;MAKE AOBJN POINTER OVER CELLS
	HRLI FLP,(GH1SP6)
	JRST GH1SP1
;FXP HAS RUNNING FREELIST
;FLP HAS AOBJN POINTER OVER CELLS
;P HAS AOBJN POINTER OVER WORDS OF BITS
GCHSW1:
OFFSET -.
GH1SP1:	MOVE SP,(P)
GH1SP2:	JUMPGE SP,GH1SP4
	HRRZM FXP,(FLP)
	HRRZI FXP,(FLP)
GHCNT1:	AOJ .,0
GH1SP4:	ROT SP,1←HNKLOG
GH1SP5:	ADDI FLP,<1←HNKLOG>-1
	AOBJN FLP,GH1SP2
GH1SP6:	HRLI FLP,<-40>←-HNKLOG
	AOBJN P,GH1SP1
	JRST GCSW5
LPROGH==:.-1
OFFSET 0
.HKILL GH1SP1 GH1SP2 @λCNT1 GH1SP4 GH1SP5 GH1SP6

]		;END OF IFN HNKLOG+DBFLAG+CXFLAG

;;;	PDLS ARE UNSAFE

IFG HNKLOG-4,[
GCSWH2:	HRRZ P,GCWORN+NFF(SP)	;GET SIZE OF OBJECTS
	HRRI GH2SP5,(P)
	SUBI P,1
	LSH P,-5
	HRRI GH2SP7,(P)		;BITS PER BIT BLOCK WORD
	HRRZ P,GCWORN+NFF(SP)
	LSH P,-5
	MOVNI SP,BTBSIZ
	IDIVM SP,P
	HRLI P,(P)		;MAKE AOBJN POINTER OVER WORDS OF BITS
	MOVE SP,GCST(FLP)
	LSH SP,SEGLOG-5
	HRRI P,(SP)
	LSH FLP,SEGLOG		;MAKE POINTER OVER CELLS
	JRST GH2SP1
;FXP HAS RUNNING FREELIST
;FLP HAS AOBJN POINTER OVER CELLS
;P HAS AOBJN POINTER OVER WORDS OF BITS
GCHSW2:
OFFSET -.
GH2SP1:	SKIPL (P)		;ONLY THE SIGN BIT OF A MARK WORD IS USED
	 JRST GH2SP5
	HRRZM FXP,(FLP)
	HRRZI FXP,(FLP)
GHCNT2:	AOJ .,0
GH2SP5:	ADDI FLP,1←HNKLOG
GH2SP7:	ADDI P,<<1←HNKLOG>-1>←-5
	AOBJN P,GH2SP1
	JRST GCSW5
LPROGK==:.-1
OFFSET 0
.HKILL GH2SP1 GH2SP2 GHCNT2 GH2SP5 GH2SP7

]		;END OF IFG HNKLOG-4

GCSWA:	LSH FLP,SEGLOG
	HRLI FLP,-SEGSIZ/2
	JRST GSSP1

GSARSWP:			;SPECIAL SWEEPER FOR SARS
OFFSET -.
GSSP0:	ADDI FLP,1
GSSP1:
	TDNN GSSP7,TTSAR(FLP)	;TEST IF SAR MARKED (OR OTHERWISE NEEDED)
	 AOJA GSCNT,GSSP2	;NO, COUNT IT AS SWEPT
	ANDCAM GSSP8,TTSAR(FLP)	;YES, TURN OFF MARK BIT
	AOBJN FLP,GSSP0		; AND TRY NEXT ONE
	JRST GCSW5
GSSP2:	HRRZM FXP,ASAR(FLP)	;CHAIN INTO FREE LIST
	HRRZI FXP,ASAR(FLP)
	AOBJN FLP,GSSP0
	JRST GCSW5
GSSP7:	TTS<CN+GC>,,
GSSP8:	TTS<GC>,,
GSCNT:	0
LPROG4==:.-1
OFFSET 0
.HKILL GSSP0 GSSP1 GSSP2 GSSP7 GSSP8 GSCNT

;;; PDLS ARE SAFE

SUBTTL	GC - MAKE SURE ENOUGH WAS RECLAIMED

GCPNT:	SKIPN GCGAGV
	 JRST GCE0
	SETZM GC99		;GC99 COUNTS ENTRIES PRINTED
	MOVNI F,NFF
GCPNT1:	HRRZ T,NFFS+NFF(F)
	SKIPN TT,SFSSIZ+NFF(F)
	 JRST GCPNT6
	SOSLE GC99
	 JRST GCPNT2
	STRT 17,[SIXBIT \↑M; !\]	;TERPRI-; EVERY THIRD ONE
	MOVEI D,3
	MOVEM D,GC99
GCPNT2:	PUSHJ P,STGPNT
	STRT 17,@GSTRT9+NFF(F)
	CAME F,XC-1			;COMMA AFTER EACH BUT LAST
	 STRT 17,[SIXBIT \, !\]
GCPNT6:	AOJL F,GCPNT1
	STRT 17,[SIXBIT \ WORDS FREE!\]

;FALLS THROUGH

;;;	PDLS ARE SAFE

SUBTTL	GC - CLEANUP AND TERMINATION

;FALLS IN

GCE0:	MOVNI F,NFF
GCE0C0:	MOVE AR2A,MFFS+NFF(F)
	TLNN AR2A,-1
	 JRST GCE0C1
	HRRZ AR1,SFSSIZ+NFF(F)
	FSC AR1,233		;FIXNUM TO FLONUM CONVERSION
	FMPR AR1,AR2A
	MULI AR1,400		;FLONUM TO FIXNUM CONVERSION
	ASH AR2A,-243(AR1)
GCE0C1:	SKIPGE FFS+NFF(F)
	 JRST GCE0C5
	CAIGE AR2A,MINCEL
	 MOVEI AR2A,MINCEL	;MUST SATISFY ABSOLUTE MIN OF<MINCEL> CELLS
GCE0C5:	MOVEM AR2A,ZFFS+NFF(F)
	HRRZ TT,NFFS+NFF(F)
	CAIGE TT,(AR2A)		;ALSO MUST SATISFY USER'S MIN
	 PUSHJ P,GCWORRY		;IF NOT, MUST WORRY ABOUT IT
GCE0C2:	AOJL F,GCE0C0
	MOVEI AR2A,1
	SKIPN FFY2
	 PUSHJ P,GRABWORRY	;REMEMBER, F IS ZERO HERE
	SKIPN FFY2
	 JRST GCLUZ
	MOVNI F,NFF		;IF WE RECLAIMED LESS THAN ABSOLUTE
GCE0C3:	HRRZ TT,NFFS+NFF(F)	; MINIMUM FOR ANY SPACE,
	SKIPGE FFS+NFF(F)
	 JRST GCE0C9
	CAIGE TT,MINCEL		; WE ARE OFFICIALLY DEAD
	 JRST GCLUZ
GCE0C9:	AOJL F,GCE0C3
	SKIPE PANICP
	 JRST GCE0C7
	MOVNI F,NFF	;NOW SEE IF WE EXCEEDED MAXIMUM
GCE0C6:	MOVE TT,SFSSIZ+NFF(F)
	CAMG TT,XFFS+NFF(F)
	 JRST GCE0K3
	HRLZ D,GCMES+NFF(F)
	HRRI D,1004		;GC-OVERFLOW
	PUSHJ P,UINT		;NOQUIT IS ON HERE, SO INTERRUPT GETS STACKED
GCE0K3:	AOJL F,GCE0C6
GCE0C7:	MOVNI F,NFF
GCE0C4:	MOVE TT,SFSSIZ+NFF(F)
	CAMG TT,XFFS+NFF(F)	;IF A SPACE LOST TO GC-OVERFLOW,
	 JRST GCE0K2		; DON'T MAKE IT LOSE FOR GC-LOSSAGE TOO
	MOVEM TT,XFFS+NFF(F)	;JUST QUIETLY UPDATE ITS GCMAX
	JRST GCE0K1

GCE0K2:	HRRZ T,NFFS+NFF(F)
	CAMGE T,ZFFS+NFF(F)
	 JRST GCLUZ
GCE0K1:	AOJL F,GCE0C4
IFN PAGING,[
	HRRZ TT,NOQUIT
	IOR TT,INHIBIT
	IOR TT,VNORET
	SKIPN TT
	PUSHJ P,RETSP
]		;END OF IFN PAGING
	SKIPE GCGAGV
	 STRT 17,STRTCR
;FALLS THROUGH

;;; PDLS ARE SAFE

;FALLS IN

	SKIPN VGCDAEMON
	 JRST GCEND
	MOVEI C,NIL		;CONS UP ARG FOR GCDAEMON
	MOVEI D,NFF-1		;WE CHECKED LENGTH OF FREELISTS SO
	SETZ C,			; WE KNOW CONSES WON'T RE-INVOKE GC
GCE0E:	MOVE TT,SFSSIZ(D)	;SIZE OF SPACE AFTER GC
	PUSHJ P,CONS1FX
	MOVE TT,OFSSIZ(D)	;SIZE OF SPACE BEFORE GC
	PUSHJ P,CONSFX
	HRRZ TT,NFFS(D)		;LENGTH OF FREELIST AFTER GC
	CAIN D,FFX-FFS		;ALLOW FOR THE SPACE USED
	 SUBI TT,4*NFF		; TO CONS UP THE GC-DAEMON ARG
	CAIN D,FFS-FFS
	 SUBI TT,6*NFF
	PUSHJ P,CONSFX
	HLRZ TT,NFFS(D)		;LENGTH OF FREELIST BEFORE GC
	PUSHJ P,CONSFX
	HRRZ A,GCMES(D)		;NAME OF SPACE
	PUSHJ P,CONS
	MOVE B,C
	PUSHJ P,CONS
	MOVE C,A
	SOJGE D,GCE0E
	JSR GCRSR		.SEE GCRSR0
	HRLI A,1003		;GC-DAEMON
	PUSH P,A		;FOR INTERRUPT PROTECTION ONLY
	PUSH FXP,D
	MOVS D,A
	PUSHJ P,UINT
	POPI P,1		;FLUSH SLOT "FOR INTERRUPT PRO ONLY"
	MOVE D,(FXP)
	MOVEM F,(FXP)		;USE AC F BELOW, SINCE GCLUZ REQUIRES IT
	MOVNI F,NFF		;IF THE RUNNING OF THE GC-DAEMON ATE UP ALL 
	SKIPN FFS+NFF(F)	; OUR SPACE, THEN LOSE BADLY!
	 JRST GCLUZ0
	AOJL F,.-2
	POP FXP,F
	JRST POPAJ		;REMEMBER! GCRSR HAS STACKED A SAVED "A"


;;; GC MUST EITHER JRST TO GCEND, OR JSR TO GCRSR BEFORE EXITING.
;;; THIS ASSURES THAT GCTIM WILL PROPERLY REFLECT TIME SPENT IN GC.
;;; THE VALUE IN GCTIM IS IN "HOST MACHINE UNITS".
;;; THESE ARE CONVERTED BEFORE BEING RETURNED TO THE USER.
.SEE SGCTIM

GCEND:
	MOVE P,GCNASV+14-<NACS+1>
	MOVE SP,GCNASV+17-<NACS+1>
	PUSHJ P,UNBIND
IFN D20,[
	MOVEI 1,.FHSLF
	RUNTM
IFN WHL,	MOVEM 1,GC98
	SUB 1,GCTM1
	ADDM 1,GCTIM			;UPDATE GCTIM FOR D20
]		;END OF IFN D20
	JSP NACS+1,GCACR		;ac's are restored *after* D20 runtime
	SETZM GCFXP			; calculations, since acs 1-3 are used
IFE D20,[
IT$	.SUSET [.RRUNT,,NACS+1]
10$	SETZ NACS+1,
10$	RUNTIM NACS+1,
IFN WHL,	MOVEM NACS+1,GC98
	SUB NACS+1,GCTM1
	ADDM NACS+1,GCTIM			;UPDATE GCTIM FOR non-D20
]	;END OF IFE D20
IFN WHL,[
	SKIPE NACS+1,GCWHO
	PUSHJ P,GCWHR
]		;END OF IFN WHL
	MOVE NACS+1,GCNASV
	HRRZS NOQUIT
	JRST CHECKI

;GCRSR:	0
GCRSR0:	HRLM C,NOQUIT		;RESTORE ACS, AND CHECK FOR ANY STACKED INTERRUPTS
	MOVE P,GCNASV+14-<NACS+1>
	MOVE SP,GCNASV+17-<NACS+1>
	PUSHJ P,UNBIND
IFN D20,[
	MOVEI 1,.FHSLF
	RUNTM			;UPDATE GCTIM FOR D20
IFN WHL,	MOVEM 1,GC98
	SUB 1,GCTM1
	ADDM 1,GCTIM
]		;END OF IFN D20
	JSP NACS+1,GCACR	;RESTORE AC'S
	SETZM GCFXP
IFE D20,[
IT$	.SUSET [.RRUNT,,NACS+1]
10$	SETZ NACS+1,
10$	RUNTIM NACS+1,
IFN WHL*<ITS+D10>,	MOVEM NACS+1,GC98
	SUB NACS+1,GCTM1
	ADDM NACS+1,GCTIM	;UPDATE GCTIME FOR (STATUS GCTIME)
]	;END OF IFE D20
IFN WHL,[
	SKIPE NACS+1,GCWHO
	 PUSHJ P,GCWHR
]		;END OF IFN WHL
	MOVE NACS+1,GCNASV
	PUSH P,A
	HLRZ A,NOQUIT
	PUSH P,GCRSR
	HRRZS NOQUIT
	JRST CHECKI

;;; ROUTINE TO INIT MARK BITS FOR LIST, FIXNUM, FLONUM, HUNK,
;;; AND BIGNUM SPACES. INIT BITS IN TT, RETURN ADDRESS IN F.

GCINBT:	MOVEM TT,BBITSG
	MOVE AR2A,[BBITSG,,BBITSG+1]
	BLT AR2A,@MAINBITBLT	;BLT OUT MAIN BIT AREA
	MOVE A,BTSGLK		;INITIALIZE ALL BIT BLOCKS
GCINB0:	JUMPE A,(F)
	MOVEI AR2A,(A)
	LSH AR2A,SEGLOG		;GET ADDRESS OF SEGMENT
	HRLI AR2A,(AR2A)
	MOVEM TT,(AR2A)
	AOJ AR2A,
	MOVE T,GCST(A)		;GET END ADDRESS FOR BLT
	LSH T,SEGLOG-5
	TLZ T,-1
	CAIE T,(AR2A)
	 BLT AR2A,-1(T)		;***BLT!***
	LDB A,[SEGBYT,,GCST(A)]
	JRST GCINB0

IFN WHL,[
GCWHR:	TRNN NACS+1,2		;SKIP IF GC STATISTICS DESIRED
	 JRST GCWHR2
	MOVE NACS+2,GCTIM
	IDIVI NACS+2,25000./4	;GC TIME IN FORTIETHS OF A SECOND
	MOVEM NACS+2,GCWHO2
	MOVE NACS+2,GCTIM	;GC TIME
	IMULI NACS+2,100.	; TIMES 100.
	IDIV NACS+2,GC98	; DIVIDED BY TOTAL RUNTIME
	HRLM NACS+2,GCWHO2	; EQUALS GC TIME PERCENTAGE
	TRNE NACS+1,1
	 JRST GCWHR2
	.SUSET [.SWHO2,,GCWHO2]	;JUST SET .WHO2 IF WHO VARS NOT PREVIOUSLY SAVED
GCWHR8:	MOVE NACS+2,GCNASV+1	;RESTORE ACS
	MOVE NACS+3,GCNASV+2
	POPJ P,

GCWHR2:	MOVE NACS+2,[-3,,GCWHR9]	;RESTORE WHO VARS, POSSIBLY WITH
	.SUSET NACS+2			; GC STATISTICS CLOBBERED INTO GCWHO2
	JRST GCWHR8

GCWHR9:	.SWHO1,,GCWHO1
	.SWHO2,,GCWHO2
	.SWHO3,,GCWHO3
]		;IFN WHL

SUBTTL	MISCELLANEOUS GC UTILITY ROUTINES

GCACRS:	MOVE SP,GCNASV+17-<NACS+1>	;RESTORE SP ALSO
GCACR:	SKIPN GCFXP
	 MOVEM FXP,GCFXP
	MOVE NIL,[GCACSAV+1,,1]	;RESTORE ALL ACS EXCEPT NACS+1
	BLT NIL,NACS
	MOVE NIL,[GCNASV+1,,NACS+2]
	BLT NIL,FXP
	MOVE NIL,GCACSAV
	SETZM GCFXP		.SEE CHNINT	;ETC.
	JRST (NACS+1)


$GCMKAR:	MOVE D,ASAR(A)
GCMKAR:	MOVE F,TTSAR(A)
	SKIPL D,-1(D)	;MARK FROM ARRAY ENTRIES.
	JRST (TT)
GCMKA1:	HLRZ A,(D)
	JSP T,GCMARK
	HRRZ A,(D)
	JSP T,GCMARK
	AOBJN D,GCMKA1
	JUMPE F,(TT)
	TLNE F,TTS<TY>
	TLNE F,TTS<IO>
	JRST (TT)
	MOVEI D,FB.BUF(F)	;FOR TTY INPUT FILE ARRAYS,
	HRLI D,-NASCII/2	; MUST MARK INTERRUPT FUNCTIONS
	SETZ F,
	JRST GCMKA1

;;; GCGEN GENERATES NON-NULL BUCKETS OF THE CURRENT OBARRAY
;;; AND APPLIES A GIVEN FUNCTION TO THEM. IT IS CALLED AS
;;;		JSP R,GCGEN
;;;		   FOO
;;; GCGEN WILL EFFECTIVELY DO A  JRST FOO  MANY TIMES,
;;; PASSING SOME NON-NULL OBARRAY BUCKET THROUGH ACCUMULATOR D.
;;; FOO IS EXPECTED TO RETURN BY DOING A  JRST GCP8A.
;;; WHEN DONE, GCGEN RETURNS, SKIPPING OVER THE ADDRESS FOO.

GCGEN:	MOVE F,@VOBARRAY	.SEE ASAR
	MOVE F,-1(F)
	SUB F,R70+1
	TLZ R,400000
GCP8A:	TLCE R,400000
	JRST GCP8A1
	AOBJP F,1(R)	;EXIT
	HLRZ D,(F)
	JUMPN D,@(R)
	JRST GCP8A
GCP8A1:	HRRZ D,(F)
	JUMPN D,@(R)
	JRST GCP8A


;;; MARK AN S-EXPRESSION GIVEN IN A. TRACES IT COMPLETELY,
;;; MARKING ALL SUBITEMS BY SETTING A MARK BIT TO **ZERO**
;;; FOR LIST, FIXNUM, FLONUM, AND BIGNUM SPACES, AND TO
;;; **ONE** FOR SYMBOLS AND SARS. (THIS SPEEDS UP SWEEPING.)
;;; NEVER MARKS VALUE CELLS!!!! (THEY ARE NEVER SWEPT.)
;;; CALLED BY JSP T,GCMARK WITH OBJECT IN A. USES A,B,C,AR1,AR2A.

GCMARK:	JUMPE A,(T)		;NEEDN'T MARK NIL
	MOVEI AR2A,(P)		;REMEMBER WHERE P IS
GCMRK0:	JRST GCMRK1	.SEE KLINIT

GCMRK3:	TLNN A,GCBSYM		;MAYBE WE FOUND A SYMBOL
	 JRST GCMRK4		;NOPE
	HLRZ AR1,(C)		;YUP
	TROE AR1,1
	 JRST GCMKND
	HRLM AR1,(C)
	PUSH P,(C)		;PUSH PROPERTY LIST
	PUSH P,(AR1)		;PUSH PNAME LIST
	SKIPE ETVCFLSP		;A HAC TO SAVE TIME IF THERE NEVER HAVE BEEN
	 JRST GCMRK6		; VALUE CELLS TAKEN FROM LIST SPACE
	HRRZ A,@-1(AR1)
	JRST GCMRK1		;GO MARK VALUE OF SYMBOL

GCMRK6:	HRRZ A,-1(AR1)
	CAIGE A,EVCSG
	 CAIGE A,BVCSG
	  JRST GCMRK7
	HRRZ A,(A)
	CAIE A,QUNBOUND
	 JRST GCMRK1
	JRST GCMRK8

GCMRK7:	LSH A,-SEGLOG
	SKIPL A,GCST(A)		;SKIP IF VALUE CELL NOT A LIST CELL??
	 JRST GCMKND		;SUNBOUND, FOR EXAMPLE????
	HRRZ A,-1(AR1)		;POINTING TO A VC IN LIST SPACE
	JRST GCMRK1

GCMRK4:	TLNN A,GCBVC		;MAYBE WE FOUND A VALUE CELL
	 JRST GCMRK5		;NOPE
	HRRZ A,(C)		;YUP - MARK ITS CDR (THE VALUE)
	JRST GCMRK1

GCMRK5:	MOVSI AR1,TTS<GC>	;MUST BE AN ARRAY
	IORM AR1,TTSAR(C)	;SET ARRAY MARK BIT TO 1
GCMKND:	CAIN AR2A,(P)		;SKIP IF ANYTHING LEFT ON STACK TO MARK
	 JRST (T)		;ELSE RETURN
GCMRK8:	POP P,A			;GET NEXT ITEM TO MARK
GCMRK1:	HRRZS C,A		;ZERO LEFT HALF OF A, ALSO SAVE IN C
	SETZ B,
	LSHC A,-SEGLOG		;GET PAGE NUMBER OF ITEM (OTHER BITS GO INTO B)
	SKIPL A,GCST(A)		;CHECK GCST ENTRY FOR THAT PAGE
	 JRST GCMKND		;NOT MARKABLE - IGNORE IT
	TLNE A,GCBFOO		;MAYBE IT'S A VALUE CELL OR SYMBOL OR SAR
	 JRST GCMRK3		;IF SO HANDLE IT SPECIALLY
	LSHC A,SEGLOG-5		;THIS GETS ADDRESS OF BIT WORD FOR THIS ITEM
	ROT B,5			;B TELLS US WHICH BIT (40/WD)
	MOVE AR1,(A)		;GET WORD OF MARK BITS
	TDZN AR1,GCBT(B)	;CLEAR THE ONE PARTICULAR BIT
	 JRST GCMKND		;QUIT IF ITEM ALREADY MARKED
	MOVEM AR1,(A)		;ELSE SAVE BACK WORD OF BITS
	JUMPGE A,GCMKND	.SEE GCBCDR	;JUMP UNLESS MUST MARK THROUGH (REMEMBER THE LSHC)
	HRR A,(C)		;GET CDR OF ITEM
	TLNN A,GCBCAR←<SEGLOG-5> ;MAYBE WE ALSO WANT TO MARK THE CAR
	 JRST GCMRK1		;NO - GO MARK CDR
	PUSH P,A		;YES - SAVE CDR ON STACK
	HLR A,(C)		;GET CAR OF ITEM AND GO MARK IT
IFE HNKLOG, 	JRST GCMRK1
IFN HNKLOG,[
	TLNN A,GCBHNK←<SEGLOG-5>
	 JRST GCMRK1		;ORDINARY LIST CELL
	PUSH P,T		;FOR HUNK, SAVE T AND AR2A SO
	HRLM AR2A,(P)		; CAN CALL GCMARK RECURSIVELY
	MOVEI A,(C)
	LSH A,-SEGLOG
	HRRZ A,ST(A)		;GET TYPEP OF HUNK
   2DIF [HRL C,(A)]GCHNLN,QHUNK0	;C NOW HAS AOBJN POINTER
	MOVEI AR2A,(P)		;SET UP AR2A FOR RECURSIVE GCMARK
GCMRK2:	MOVEM C,-1(P)		;SAVE AOBJN POINTER IN SLOT PUSHED FOR CDR
	HLRZ A,(C)
	JUMPE A,GCMK2A
	JSP T,GCMRK1		;MARK ODD HUNK SLOT
	MOVE C,-1(P)
GCMK2A:	HRRZ A,(C)
	JUMPE A,GCMK2B
	JSP T,GCMRK1		;MARK EVEN HUNK SLOT
	MOVE C,-1(P)
GCMK2B:	AOBJN C,GCMRK2
	POP P,T			;RESTORE T AND AR2A
	HLRZ AR2A,T
	SUB P,R70+1		;FLUSH AOBJN POINTER
	JRST GCMKND

GCHNLN:	-1
	REPEAT HNKLOG, -<2←.RPCNT>	;LH'S FOR AOBJN POINTERS
]		;END OF IFN HNKLOG

COMMENT |	ONE OF THESE DAYS I'LL DEBUG THE MICROCODE FOR THIS - GLS

IFN ITS,[ IFE SEGLOG-11,[ IFLE HNKLOG-5,[
;;; MARK ROUTINE FOR USE WITH KL-10 MICROCODE

LSPGCM=:070000,,
LSPGCS=:071000,,

KLGCVC:	SKIPA A,(A)
	 PUSH P,B
KLGCM1:	LSPGCM A,KLGCM2
KLGCND:	CAIN AR2A,(P)
	 JRST (T)
	POP P,A
	JRST KLGCM1

KLGCM2:	JRST KLGCSY
	JRST KLGCVC
	JRST KLGCSA
REPEAT HNKLOG, JRST CONC KLGH,\.RPCNT+1
REPEAT 8-.+KLGCM2, .VALUE

KLGCSY:	HLRZ AR1,(A)
	TROE AR1,1
	 JRST KLGCND
	HRLM AR1,(A)
	PUSH P,(A)
	PUSH P,(AR1)
	HRRZ A,@-1(AR1)
	JRST KLGCM1

KLGCSA:	MOVSI AR1,TTS<GC>
	IORM AR1,TTSAR(A)
	JRST KLGCND

IFN HNKLOG,[
ZZZ==<1←HNKLOG>-1
REPEAT HNKLOG,[
CONC KLGH,\HNKLOG-.RPCNT,:
REPEAT 1←<HNKLOG-.RPCNT-1>,[
	PUSH P,ZZZ(A)
	HLRZ B,(P)
	PUSH P,B
ZZZ==ZZZ-1
]		;END OF REPEAT 1←<HNKLOG-.RPCNT-1>
]		;END OF REPEAT HNKLOG
IFN ZZZ, WARN [YOU LOSE]
	PUSH P,(A)
	HLRZ A,(A)
	JRST KLGCM1
]		;END OF IFN HNKLOG


KLGCSW:	MOVNI T,3+BIGNUM		;SWEEP
KLGS1:	SETZB C,AR1			;ZERO FREELIST AND COUNT
	SKIPN TT,FSSGLK+3+BIGNUM(T)
	 JRST KLGS1D
KLGS1A:	MOVE B,GCST(TT)
	LSH B,SEGLOG-5
	TLZ B,-1
	MOVEI A,(TT)
	LSH A,SEGLOG
	HRLI A,-SEGSIZ
	LSPGCS A,1
	LDB TT,[SEGBYT,,GCST(TT)]
	JUMPN TT,KLGS1A
KLGS1D:	MOVEM C,FFS+3+BIGNUM(T)
	HRRM AR1,NFFS+3+BIGNUM(T)
	AOJL T,KLGS1
	JRST GCSW4A

]]]		;END OF IFLE HNKLOG-5, IFE SEGLOG-11, IFN ITS

|		;END OF COMMENT

GSGEN:	SKIPN AR2A,GCMKL	;GENERATE TAILS OF GCMKL AND APPLY 
	POPJ P,			;FUN IN AR1 TO THEM
	PUSH P,AR1
	MOVEI AR1,GCMKL
	JRST GGEN1

RTSPC2:	JUMPE A,GGEN2
RTSP2A:	ADD D,TT
GGEN2:	HRRZ AR2A,(AR2A)	;GENERAL LOOP FOR GSGEN
	MOVEI AR1,(AR2A)
	HRRZ AR2A,(AR2A)
GGEN1:	JUMPE AR2A,POP1J	;TAIL OF GCMKL IN AR2A,
	HRRZ A,(AR2A)		;SPACE OCCUPIED IN TT,
	HLRZ A,(A)		;ALIVEP IN A
	MOVE TT,(A)
	HLRZ A,(AR2A)
	HLRZ A,ASAR(A)
	JRST @(P)	;ROUTINE WILL RETURN TO GGEN2


GFSPC:	PUSH FXP,AR1
	PUSHJ P,CNLAC	;COUNT NUMBER OF LIVING ARRAY CELLS
	POP FXP,AR1
	ADD D,@VBPORG	;NOW HAS TOTAL AMOUNT FREE IN BPS [COUNTING DEAD BLOCKS]
	ADD D,GAMNT	;NOW DIMINISHED BY REQUESTED AMOUNT
	CAMG D,BPSH
	JRST GRELAR	;IF ENOUGH SPACE, THEN RELOCATE
	JRST (R)

IFN PAGING,[
GTSP5A:	SETZB A,TT		;GIVE OUT NIL AND 0 IF FAIL
	JUMPLE AR1,CZECHI
	PUSHJ P,BPSGC
	JSP R,GFSPC
	SETZ AR1,
	JRST GTSP1B
]		;END OF IFN PAGING

BPSGC:	PUSH FXP,NOQUIT		;SAVE CURRENT STATE OF FLAG
	HLLZS NOQUIT		;FORCE OFF RIGHT HALFWORD
	PUSH P,[444444,,BPSGX]	;MAGIC NUMBER,,RETURN ADR
	JRST AGC
BPSGX:	POP FXP,NOQUIT		;RESTORE OLD SETTING OF FLAGS
	POPJ P,

;;; SOME ROUTINES FOR USE WITH GSGEN

GCP8K:	HLRZ A,(D)
	JSP T,GCMARK
GCP8J:	HRRZ D,(D)	;MARK ATOMS ON OBLIST
GCP8I:	JUMPE D,GCP8A	;WHICH HAVE NON-TRIVIAL
	MOVE A,D	;P-LIST STRUCTURE.
	JSP T,TWAP
	JRST GCP8J
	JRST GCP8K
	JRST GCP8J

GCP8G:	JUMPE D,GCP8A	;REMOVE T.W.A.'S FROM
	MOVE A,D	;BUCKETS OF OBLIST.
	JSP T,TWAP
	JRST GCP8B
	JRST GCP8B
	HRRZ D,(D)
	TLNE R,400000	;BUCKET COMES FROM LH OF WORD IN OBARRAY
	HRLM D,(F)	;IF AT THIS POINT R < 0
	TLNN R,400000
	HRRM D,(F)
	JSP T,GCP8L
	JRST GCP8G
GCP8C:	HRRZ D,(D)
GCP8B:	HRRZ A,(D)
GCP8D:	JUMPE A,GCP8A
	JSP T,TWAP
	JRST GCP8C
	JRST GCP8C
	HRRZ A,(D)
	HRRZ A,(A)
	HRRM A,(D)
	JSP T,GCP8L
	JRST GCP8B

GCP8H:	MOVE A,D	;MARK OBLIST BUCKET
	JSP T,GCMARK
	JRST GCP8A

GCP8L:	JUMPE TT,(T)	;IF SCO REMOB'D, THEN REMOVE FROM SCO TABLE
	HRRZ A,(TT)
	JUMPN A,(T)
	HLRZ A,(TT)
	MOVE B,(A)	;MUST NOT BE INTERRUPTIBLE HERE
	MOVEI A,0
	LSHC A,7
	JUMPN B,(T)
	HRRZ TT,VOBARRAY
	HRRZ TT,TTSAR(TT)
	ADDI TT,<OBTSIZ+1>/2
	ROT A,-1
	ADD TT,A
	JUMPL TT,GCP8L5
	HRRZS (TT)
	JRST (T)
GCP8L5:	HLLZS (TT)
	JRST (T)

TWAP:	HLRZ A,(A)
	JUMPE A,(T)		;NIL IS ALREADY MARKED
	HLRZ TT,(A)
	TRZE TT,1
	 JRST (T)		;NO SKIP IF ALREADY MARKED
	MOVE B,SYMVC(TT)
	MOVE TT,SYMARGS(TT)
	TLNN B,SY.CCN\SY.PUR	;SKIP 1 IF SYMBOL HAS SOME NON-TRIVIAL
	 TLZE TT,-1		;PROPERTIES:  ARGS OR COMPILED CODE REFERENCE
	  JRST 1(T)
	HRRZ B,(B)
	HRRZ A,(A)
	CAIN B,QUNBOUND
	 JUMPE A,2(T)		;SKIP 2 IF TRULY WORTHLESS SYMBOL,
				; I.E., UNBOUND AND NO PROPERITES
	JRST 1(T)		;SKIP 1 IF MEANINGFUL PROPERTIES OR VALUE

;;; PRINT MESSAGE OF FORM "NNN[MM%] " FOR GC STATISTICS OUTPUT

STGPNT:	PUSH FXP,F		;NEED TO SAVE F (IN CASE OF IFORCE)
	PUSH FXP,T		;RECLAIMED AMNT IN T, TOTAL FOR SPACE IN TT
	IMULI T,100.
	IDIVM T,TT
	EXCH TT,(FXP)
	HRRZ AR1,VMSGFILES
	TLO AR1,200000
	MOVEI R,$TYO
IFE USELESS,	MOVE C,@VBASE	;BASE HAD DAMNED WELL BETTER BE A FIXNUM
IFN USELESS,[
	HRRZ C,VBASE
	CAIE C,QROMAN
	 SKIPA C,(C)
	  PUSHJ P,PROMAN		;SKIPS
]		;END OF IFN USELESS
	   PUSHJ P,PRINI2
	STRT 17,[SIXBIT \[!\]	;BEWARE THESE BRACKETS!!!!!
	POP FXP,TT
IFE USELESS,	MOVEI C,10.
IFN USELESS,[
	HRRZ C,VBASE
	CAIE C,QROMAN
	 SKIPA C,[10.]
	  PUSHJ P,PROMAN
]		;END OF IFN USELESS
	   PUSHJ P,PRINI3	;EFFECTIVELY, PRINI2 WITH *NOPOINT=T
	STRT 17,[SIXBIT \%] !\]	;BEWARE THESE BRACKETS!!!!!
	POP FXP,F
	POPJ P,


;;; VERY IMPORTANT TABLE OF WORDS WITH SINGLE BITS!!! USED FOR MARKING!!!
GCBT:	REPEAT 36., SETZ←-.RPCNT

IFN PAGING,[

SUBTTL	RETURN CORE TO TIMESHARING SYSTEM

;;; HAIRY ROUTINE TO DECIDE WHETHER TO RETURN SOME BPS TO THE SYSTEM.
;;; MAY ONLY BE CALLED WHEN NOQUIT SPECIFIES NO INTERRUPTS.

RETSP:
10$	POPJ P,			;NOOP ON D10'S RUNNING PAGING LISP
IFE D10,[
	MOVEI TT,4		;GTSPC1 IS ALLOWED TO GRAB 4 PAGES
	MOVEM TT,ARPGCT		; BEFORE INVOKING GC FOR LACK OF CORE
	PUSHJ P,CNLAC		;COUNT NUMBER OF LIVING ARRAY CELLS
	MOVE TT,BPSH
	LSH TT,-PAGLOG		;CURRENT HIGHEST CORE BLOCK IN BPS
	MOVE R,@VBPORG
	ADDI R,1(D)
	LSH R,-PAGLOG		;CORE NEEDED IF ARRAYS WERE PACKED
	CAML R,TT
	POPJ P,
	LSH R,PAGLOG
	ADDI R,PAGSIZ-1
	HRLM R,RTSP1		;NEW BPSH
	SUB R,D
	HRRM R,RTSP3		;NEW BPEND
	JUMPE D,RTSP5
	HRLM D,RTSP3		;NUMBER OF CELLS TO MOVE
	PUSHJ P,GRELAR		;GRELAR LEAVES BPEND-AFTER-RELOCATION IN TT
	HRL AR1,TT
	HRR AR1,RTSP3		;BLOCK PTR
	SUBI TT,(AR1)
	JUMPLE TT,RTSP2
	MOVNI TT,1(TT)
	HRRM TT,RTSP1
	ADD AR1,R70+1
	HLRZ C,RTSP3
	ADD C,RTSP3
	BLT AR1,(C)
	MOVEI AR1,RTSPC1
	PUSHJ P,GSGEN		;DO PATCH-UP ON ARRAY PARAMETERS
	JSP T,RSXST		;????
RTSP2:	HLRZ TT,RTSP1
	MOVE R,TT
	EXCH R,BPSH
	HRRZ D,RTSP3
	MOVEM D,@VBPEND
	LSH R,-PAGLOG		;OLD CORE HIGHEST
	LSH TT,-PAGLOG		;NEW CORE HIGHEST
	MOVEI F,1(TT)		;MAKE UP A POINTER INTO THE PURTBL
	ROT F,-4
	ADDI F,(F)
	ROT F,-1
	TLC F,770000
	ADD F,[450200,,PURTBL]
IT$	SUBM TT,R		;FOR ITS, MINUS THE NUMBER OF PAGES TO HACK
20$	SUBI R,(TT)		;FOR D20, THE POSITIVE NUMBER OF PAGES TO HACK
	AOS D,TT
IFN ITS,[
	HRLI TT,(R)		;-<NUMBER OF PAGES>,,<INITIAL PAGE NUMBER>
	.CALL RTSP9		;FLUSH THE PAGES
	 .LOSE 1000
]		;END OF IFN ITS
IFN D20,[
	SETO 1,			;-1 MEANS DELETE PAGES
	MOVSI 2,.FHSLF		;FROM SELF
	HRRI 2,(TT)		;INITIAL PAGE NUMBER
	MOVEI 3,(R)		;NUMBER OF PAGES
	TLO 3,PM%CNT		;SET ITERATION BIT
	PMAP
]		;END OF IFN D20
	LSH D,-SEGLOG+PAGLOG
	MOVE T,[$NXM,,QRANDOM]	;STANDARD ST ENTRY FOR A FLUSHED PAGE
RTSP7:	TLNN F,730000
	 TLZ F,770000
	IDPB NIL,F		;UPDATE PURTBL ENTRY FOR ONE PAGE
REPEAT SGS%PG,	MOVEM T,ST+.RPCNT(D)	;UPDATE ST ENTRIES
	ADDI D,SGS%PG
IT$	AOJL R,RTSP7
20$	SOJG R,RTSP7
	POPJ P,

IFN ITS,[
RTSP9:	SETZ
	SIXBIT \CORBLK\		;HACK PAGE MAP
	  1000,,0		;DELETE PAGES
	  1000,,%JSELF		;FROM CURRENT JOB
	400000,,TT		;AOBJN POINTER: -<COUNT>,,<PAGE NUMBER>
]		;END OF IFN ITS

RTSP5:	SETZM GCMKL	;NO ARRAYS ALIVE
	MOVE TT,R
	PUSHJ P,BPNDST	;SETQ UP BPEND
	JRST RTSP2

RTSPC1:	JUMPE A,GGEN2
	HRRE B,RTSP1	;-<SIZE OF SHIFT + 1>
	JSP AR1,GT3D
	JRST GGEN2

]	;END IFE D10
]		;END OF IFN PAGING

SUBTTL	GET SPACE FROM TIMESHARING SYSTEM

GTSPC1:	HLLOS NOQUIT
	JSP R,GFSPC		;SEE IF FREE SPACE ABOVE BPEND WILL ADD ENOUGH
IFN PAGING,[
	SKIPLE AR1,ARPGCT
	 JRST GTSP1B
]		;END OF IFN PAGING
	PUSHJ P,BPSGC		;WHEN COMPACTIFIED AND RELOCATED
	JSP R,GFSPC		;IF NOT, GC AND TRY AGAIN
GTSP1B:
IFE PAGING,[
	SETZB A,TT		;GIVE OUT NIL AND 0 IF WE FAIL
	JRST CZECHI
]		;END OF IFE PAGING
IFN PAGING,[
	CAML D,HINXM
	 JRST GTSP5A
	MOVEI T,(D)
	TRO T,PAGSIZ-1
	MOVE R,BPSH
	LSH D,-PAGLOG
	LSH R,-PAGLOG
	SUBM R,D		;NEGATIVE OF NUMBER OF PAGES TO GET
	ADDM F,ARPGCT
	MOVEI F,1(R)		;SET UP BYTE POINTER INTO PURTBL
	ROT F,-4
	ADDI F,(F)
	ROT F,-1
	TLC F,770000
	ADD F,[450200,,PURTBL]
	MOVEI TT,1(R)
	LSH TT,-SEGLOG+PAGLOG
	HLRZ AR1,(P)		;BEWARE! LH OF CALLING PDL SLOT = -1
	TRNN AR1,1		; MEANS THE GETSP FUNCTION IS CALLING
	 TROA AR1,3
	  MOVEI AR1,1
IFN ITS,[
	HRLI R,(D)
	HRRI R,1(R)
	.CALL GTSPC8
	 .LOSE 1000
]		;END OF IFN ITS
IFN D20,[
	PUSH P,D		;SAVE NEGATIVE COUNT
	PUSH P,R		;AND SAVE CURRENT PAGE NUMBER
GTSPC8:	AOS R,(P)		;GET NEXT PAGE NUMBER
	LSH R,PAGLOG		;TURN INTO POINTER TO PAGE
	SETMM (R)		;CREATE THE PAGE
	MOVSI 1,.FHSLF		;OUR PROCESS
	HRR 1,(P)		;CURRENT PAGE NUMBER
	MOVSI 2,(PA%RD\PA%WT\PA%EX) ;READ, WRITE, EXECUTE
	SPACS			;SET THEPAGE ACCESS
	AOJL D,GTSPC8
	POP P,R
	POP P,D
]		;END OF IFN D20
	MOVE A,[$XM,,QRANDOM]
GTSPC2:	TLNN F,730000
	 TLZ F,770000
	IDPB AR1,F		;UPDATE PURTBL ENTRY
REPEAT SGS%PG,	MOVEM A,ST+.RPCNT(TT)	;UPDATE ST ENTRIES
	ADDI TT,SGS%PG
	AOJL D,GTSPC2
	MOVEM T,BPSH		;FALLS INTO GRELAR
]		;END OF IFN PAGING
GRELAR:	HLLOS NOQUIT	;MOBY DELAYED QUIT FEATURE.
	HRRZ A,BPSH	;LEAVE BPEND-AFTER-RELOCATION AS RESULT
	MOVEM A,GSBPN	;TEMPORARY BPEND
	MOVEI AR1,GTSPC3
	PUSHJ P,GSGEN	;RELOCATE ARRAYS
	JSP T,RSXST
GREL1:	MOVE TT,GSBPN
	PUSHJ P,BPNDST
	MOVE TT,(A)
CZECHI:	HLLZS NOQUIT
	JRST CHECKI	;CHECK FOR ↑G THEN POPJ P,

IFN ITS,[
GTSPC8:	SETZ
	SIXBIT \CORBLK\		;HACK PAGE MAP
	  1000,,%CBNDR+%CBNDW	;NEED READ AND WRITE ACCESS
	  1000,,%JSELF		;FOR MYSELF
	      ,,R		;AOBJN POINTER: -<COUNT>,,<PAGE NUMBER>
	401000,,%JSNEW		;WANT FRESH PAGES
]		;END OF IFN ITS

SUBTTL	ARRAY RELOCATOR

CNLAC:	MOVEI D,0		;COUNT NUMBER OF LIVING ARRAY CELLS, IN D
	MOVEI AR1,RTSPC2
	JRST GSGEN

BPNDST:	JSP T,FIX1A		;STORE NEW VALUE FOR BPEND
	MOVEM A,VBPEND
	POPJ P,

;;; COMES HERE FROM GRELAR VIA GSGEN.  AR2A HAS TAIL OF GCMKL, TT HAS TOTAL LENGTH OF ARRAY
GTSPC3:	JUMPE A,GT3G		;RELOCATE AN ARRAY
	MOVEI AR1,-1(TT)	;LENGTH-1 OF ARRAY IN AR1
	HLRZ F,(AR2A)
	HRRZ A,ASAR(F)
	SUBI A,1		;ARRAY AOBJN PTR LOC IN A.
	MOVE C,GSBPN
	SUBI C,(AR1)
	MOVEM C,GSBPN		;LOC NEW BPTR IN C
	MOVEI B,(C)
	SUBI B,1(A)		;RELOCATION AMOUNT-1 IN B
	CAML A,C		;IS ARRAY ALREADY IN PLACE?
	 JRST GT3C		;YES, SO EXIT
IFN D10,[
	MOVE R,ASAR(F)
	MOVE F,TTSAR(F)
	TLNN R,AS.FIL		;IF THE ARRAY IS A FILE OBJECT,
	 JRST GT3H		; IS NOT CLOSED, AND HAS BUFFERS,
	TLNN F,TTS.CL		; THEN WE MUST LET THE I/O COMPLETE
	 SKIPGE F.MODE(F)	.SEE FBT.CM
	  JRST GT3H
IFE SAIL,[
	TLNN F,TTS.IO		;OUTPUT?
	 JRST GT3Z		;NOPE, JUST WAIT
	MOVE T,F.CHAN(F)	;GET CHANNEL NUMBER
	LSH T,27
	TLO T,(OUTPUT)		;FLUSH ALL OUTPUT BUFFERS
	XCT T
]	;END IFE SAIL
GT3Z:	MOVE F,F.CHAN(F)
	LSH F,27
	IOR F,[WAIT 0,]		;WAIT FOR THE I/O TO SETTLE DOWN
	XCT F			; SO WE CAN RELOCATE THE BUFFERS
GT3H:
]		;END OF IFN D10
	SUBI C,(AR1)
	CAMGE A,C		;BEWARE: C COULD GO NEGATIVE!
	 JRST GT3A		;GOOD, EASY BLT
	ADDI C,(AR1)
	ADDI AR1,1(A)		;FIRST DESTINATION LOC
GT3B:	HRRZI C,(AR1)
	SUBI AR1,1(B)		;CONSTRUCT SOURCE ADDRESS
	HRLI C,(AR1)
	HRRZI T,(C)
	ADDI T,(B)
	BLT C,(T)		;SERIES OF SMALL BLTS
	CAMLE AR1,GSBPN
	 JRST GT3B
	ADDI AR1,(B)
	SUB AR1,GSBPN
	MOVE A,GSBPN
	SUBI A,1(B)
GT3A:	MOVE C,GSBPN
	ADDI AR1,(C)
	HRL C,A
	BLT C,(AR1)	;FINAL (OR ONLY) BLT
	JSP AR1,GT3D
GT3C:	SOS GSBPN
	JRST GGEN2

GT3D:	ADDI B,1
	HLRZ A,(AR2A)
	ADDM B,ASAR(A)	;UPDATE ARRAY POINTERS BY OFFSET IN B
	ADDM B,TTSAR(A)
	MOVE C,ASAR(A)
	ADDM B,-1(C)	;UPDATE AOBJN PTR BEFORE ARRAY HEADER
	HRR C,TTSAR(A)		;FOR A BUFFERED FILE OBJECT, WE MUST
	TLNE C,AS.FIL		; RELOCATE CERTAIN ADDRESSES IN THE ARRAY DATA
	 SKIPGE F.MODE(C)	.SEE FBT.CM
	  JRST (AR1)
	MOVE C,TTSAR(A)
IFN ITS+D20,[
	ADDM B,FB.IBP(C)
	ADDM B,FB.BP(C)
	JRST (AR1)
]		;END OF ITS+D20
IFN D10,[
	TLNE C,TTS.CL		;DON'T HACK WITH CLOSED FILE OBJECTS
	 JRST (AR1)
	MOVE F,FB.HED(C)
	ADDM B,(F)		;UPDATE CURRENT BUFFER ADDRESS
	ADDM B,1(F)		;UPDATE BYTE POINTER
	HRRZ F,(F)
	MOVE R,F
GT3D2:	ADDM B,(R)		;UPDATE BUFFER RING POINTERS
	HRRZ R,(R)
	CAIE R,(F)		;DONE WHEN WE HAVE GONE AROUND THE RING
	 JRST GT3D2

IFN SAIL,[
	MOVE R,F.CHAN(C)	;GET CHANNEL NUMBER
	LSH R,27
	HRR R,FB.HED(C)		;POINTER TO BUFFER HEADER
	HRR R,(R)		;GET CURRENT ADDR OF BUFFER
	TLNN C,TTS.IO		;DO APPROPRIATE UUO TO MOVE BUFFER
	 TLOA R,(INPUT)
	  TLO R,(OUTPUT)
	XCT R
	JRST (AR1)
]	;END OF IFN SAIL
IFE SAIL,[
	TLNN C,TTS.IO
	 JRST GT3D4
	MOVE R,F.CHAN(C)	;GET CHANNEL NUMBER
	LSH R,27		;FOR OUTPUT BUFFERS
	HRR R,FB.HED(C)		;GET CURRENT ADR OF BUFFER
	HRR R,(R)
	TLO R,(OUTPUT)		;DO APPROPRIATE UUO TO MOVE BUFFER
	XCT R
	JRST (AR1)

GT3D4:	MOVSI R,TTS.BM
	IORM R,TTSAR(A)
	JRST (AR1)
]	;END OF IFE SAIL

]		;END OF IFN D10

GT3G:	HRRZ AR2A,(AR2A)
	HRRZ AR2A,(AR2A)
	HRRM AR2A,(AR1)		;CUT OUT DEAD BLOCK
	JRST GGEN1

	PGTOP GC,[GARBAGE COLLECTOR]

;;; ********** MEMORY MANAGEMENT, ETC **********

SUBTTL	PURCOPY FUNCTION

	PGBOT BIB

PURCOPY:
	PUSHJ FXP,SAV5M2
	PUSH P,[RST5M2]
	PUSH FXP,CCPOPJ
	PUSHJ P,SAVX5
	PUSH P,[RSTX5]
	MOVEI TT,(A)	;USES A,B,T,TT
	LSH TT,-SEGLOG
	MOVE TT,ST(TT)
	TLNE TT,PUR
	 POPJ P,
   2DIF JRST (TT),PCOPY9,QLIST	.SEE STDISP

PCOPY9:	JRST PCOPLS		;LIST
	JRST PCOPFX		;FIXNUM
	JRST PCOPFL		;FLONUM
DB$	JRST PCOPDB		;DOUBLE
CX$	JRST PCOPCX		;COMPLEX
DX$	JRST PCOPDX		;DUPLEX
BG$	JRST PCOPBN		;BIGNUM
	JRST PCOPSY		;SYMBOL
HN$ REPEAT HNKLOG+1, JRST PCOPHN	;HUNKS
	POPJ P,			;RANDOM
	JRST PCOPAR		;ARRAY
IFN .-PCOPY9-NTYPES, WARN [WRONG LENGTH TABLE]

PCOPAR:	MOVSI TT,TTS.CN
	IORM TT,TTSAR(A)		;SET "COMPILED CODE NEEDS ME" BIT
	POPJ P,



PCOPLS:	SKIPE R,VPURCOPY
	 JSP T,PURMMQ
	HLRZ B,(A)		;PURCOPY A LIST ALREADY
	PUSH P,B
	HRRZ A,(A)
	SKIPE A			;NEVER PURCOPY NIL
	 PUSHJ P,PURCOPY
	EXCH A,(P)
	SKIPE A			;NEVER PURCOPY NIL
	 PUSHJ P,PURCOPY
	POP P,B
PCONS:	AOSL TT,NPFFS		;PURE FS CONSER
   SPECPRO INTPPC
	PUSHJ P,GTNPSG		;NOTE: CLOBBERS TT
	ADD TT,EPFFS
   NOPRO
	HRLM A,(TT)
	HRRM B,(TT)
	MOVEI A,(TT)
	POPJ P,

PURMMQ:	HLRZ D,(R)	;"POPJ P," IF ITEM IS ON "PURCOPY" LIST
	CAIN A,(D)
	 POPJ P,
	HRRZ R,(R)
	JUMPN R,PURMMQ
	JRST (T)

PCOPFX:	MOVE TT,(A)
PFXCONS:	CAIGE TT,XHINUM	;PURE FIXNUM CONSER
	CAMGE TT,[-XLONUM]
	JRST PFXC1
	MOVEI A,IN0(TT)
	POPJ P,			;NOTE: EXITS WITH POPJ P,!!!
PFXC1:	AOSL A,NPFFX
   SPECPRO INTPPC
	PUSHJ P,GTNPSG
	ADD A,EPFFX
   NOPRO
PFXC3:	MOVEM TT,(A)
	POPJ P,


PCOPFL:	MOVE TT,(A)
PFLCONS:	AOSL A,NPFFL	;PURE FLONUM CONSER
   SPECPRO INTPPC
	PUSHJ P,GTNPSG
	ADD A,EPFFL
   NOPRO
	JRST PFXC3		;ALSO EXITS WITH POPJ P,!!!


IFN CXFLAG,[
PCOPCX:
KA	MOVE D,1(A)
KA	MOVE TT,(A)
KIKL	DMOVE TT,(A)
PCXCONS:	AOSL A,NPFFC
   SPECPRO INTPPC
	 PUSHJ P,GTNPSG
   XCTPRO
	MOVEI T,1(A)
	MOVEM T,NPFFC
	ADD A,EPFFC
   NOPRO
DB%	JRST PDBC3		;WILL DROP IN IF NO DOUBLES
]		;END OF IFN CXFLAG
IFN DBFLAG,[
PCOPDB:
KA	MOVE D,1(A)
KA	MOVE TT,(A)
KIKL	DMOVE TT,(A)
PDBCONS:	AOSL A,NPFFD
   SPECPRO INTPPC
	 PUSHJ P,GTNPSG
   XCTPRO
	MOVEI T,1(A)
	MOVEM T,NPFFD
	ADD A,EPFFD
   NOPRO
]		;END OF IFN DBFLAG
IFN DBFLAG+CXFLAG,[
PDBC3:
KA	MOVEM D,1(A)
KA	JRST PFXC3
KIKL	DMOVEM TT,(A)
KIKL	POPJ P,
]		;END OF IFN DBFLAG+CXFLAG


IFN DXFLAG,[
PCOPDX:
KA	REPEAT 4, MOVE TT+<2#.RPCNT>,.RPCNT
KIKL	DMOVE R,(A)
KIKL	DMOVE TT,2(A)
PDXCONS:	AOSL A,NPFFZ
   SPECPRO INTPPC
	 PUSHJ P,GTNPSG
   XCTPRO
	MOVEI T,3(A)
	MOVEM T,NPFFZ
	ADD A,EPFFZ
   NOPRO
KA	REPEAT 4, MOVEM TT+<2#.RPCNT>,.RPCNT
KIKL	DMOVEM R,(A)
KIKL	DMOVEM TT,2(A)
	POPJ P,
]		;END OF IFN DBFLAG

IFN BIGNUM,[
PCOPBN:	PUSH P,(A)
	HRRZ A,(A)
	PUSHJ P,PURCOPY
	HLL A,(P)
	SUB P,R70+1
PBNCONS:	AOSL TT,NPFFB	;PURE BIGNUM CONSER
   SPECPRO INTPPC
	PUSHJ P,GTNPSG
	ADD TT,EPFFB
   NOPRO
	MOVEM A,(TT)
	MOVEI A,(TT)
	POPJ P,
]		;END OF IFN BIGNUM

PCOPSY:	PUSH P,A		;SAVE POINTER TO SYMBOL
	HLRZ B,(A)		;FETCH POINTER TO SYMBOL BLOCK
	MOVE TT,SYMVC(B)
	TLNE TT,SY.PUR		;IF ALREADY PURE IGNORE COMPLETELY
	 JRST PCOPS1
	PUSH P,B		;SAVE SYMVC ADR
	HRRZ A,SYMPNAME(B)
	PUSHJ P,PURCOPY		;PURCOPY THE PNAME
	PUSHJ P,PSYCONS		;GET A PURE SY2 BLOCK
	POP P,B			;RESTORE SYMVC ADR
	HLRZ A,(A)		;GET POINTER TO PURE SY2
	HRRZ TT,SYMVC(B)	;GET THE VALUE CELL
	HRRM TT,SYMVC(A)	;COPY INTO NEW PURE SY2
	HLLZ TT,SYMARGS(B)	;ALSO COPY THE ARGS PROPERTY
	HLLM TT,SYMARGS(A)
XCTPRO
	HLRZ B,@(P)		;GET POINTER TO OLD SY2
	EXCH B,FFY2		;THIS IS NEW HEAD OF FREELIST, GET OLD HEAD
	MOVEM B,@FFY2		;PLACE CHAIN IN NEWLY FREED CELL
NOPRO
	HRLM A,@(P)		;STORE POINTER TO NEW SY2 BLOCK
PCOPS1:	LOCKI
	HRRZ A,(P)		;GET POINTER TO SYMBOL
	PUSHJ P,SYMHSH		;GET HASH VALUE
	IDIVI T,OBTSIZ		;MAKE POINTER INTO OBARRAY
	PUSH FXP,TT
	MOVEI A,(FXP)
	MOVE T,VOBARRAY
	PUSHJ P,@ASAR(T)	;BUCKET ADR
	MOVEI B,(A)
	HRRZ A,(P)
	PUSHJ P,MEMQ1		;FIND ACTUAL ATOM
	POP FXP,D
	JUMPN A,PCOPS3		;IF IN OBARRAY NO NEED TO GCPROTECT
	MOVEI T,1		;GCPROTECT
	HRRZ A,(P)
	PUSHJ P,.GCPRO
PCOPS3:	UNLOCKI			;CLEANUP AND GO HOME
	JRST POPAJ

IFN HNKLOG,[
PCOPHN:	SKIPN VHUNKP		;TREAT HUNKS AS LISTS IF HUNKP IS NIL
	 JRST PCOPLS
	SKIPE R,VPURCOPY
	 JSP T,PURMMQ
	PUSH P,A
	PUSH FXP,TT
	PUSHJ P,USRHNP		;Is this a user's extended object?
	POP FXP,TT
	JUMPE T,PCOPH5
	PUSH P,[QPURCOPY]
	MOVNI T,2
	XCT SENDI		; Does a JCALL

PCOPH5:	POP P,A
PCOPH2:
   2DIF [HRRZ B,(TT)]GCWORN,QLIST
	PUSH P,B		.SEE INTXCT	;CAN'T USE FXP
   2DIF [AOSL B,(TT)]NPFFS,QLIST	;THIS WORD SERVES AS ARG TO GTNPSG
   SPECPRO INTPPC
	 PUSHJ P,GTNPSG
   XCTPRO
	MOVE D,B
	ADD D,(P)
	SOS D			;SINCE ALREADY AOS'ED ONCE
   2DIF [MOVEM D,(TT)]NPFFS,QLIST
   NOPRO
   2DIF [ADD B,(TT)]EPFFS,QLIST	;B NOW HAS ADDRESS OF FRESH PURE HUNK
	PUSH P,A
	PUSH P,B
	MOVE D,-2(P)
PCOPH3:	ADD D,-1(P)		;WE SCAN THE OLD HUNK FROM THE END BACKWARDS
	HLRZ B,-1(D)		;GOBBLE A CAR AND A CDR
	HRRZ A,-1(D)
	PUSH P,B
	PUSHJ P,PURCOPY		;PURCOPY THE CDR
	EXCH A,(P)
	PUSHJ P,PURCOPY		;PURCOPY THE CAR
	HRLM A,(P)
	MOVE D,-1(P)		;CALCULATE PLACE IN NEW HUNK
	ADD D,-3(P)
	POP P,-1(D)		;POP COPIED CAR/CDR PAIR INTO PURE HUNK
	SOSE D,-2(P)
	 JRST PCOPH3
	POP P,A			;RETURN NEW HUNK
	SUB P,R70+2
	POPJ P,

]		;END OF IFN HNKLOG

IFN PAGING,[

SUBTTL	GETCOR

;;; THIS ROUTINE IS SPECIFICALLY FOR PEOPLE WHO HAND-CODE LAP.
;;; IT IS USED TO ALLOCATE A NUMBER OF CONSECUTIVE PAGES
;;; OF MEMORY FOR VARIOUS PURPOSES, E.G. HACKING OF PDP-11'S
;;; OR INFERIOR JOBS OR WHATEVER.
;;; THE NUMBER OF PAGES DESIRED SHOULD BE IN TT; THE LOW ADDRESS
;;; OF THE PAGES IS RETURNED IN TT, OR ZERO FOR FAILURE.
;;; THIS ROUTINE DOES NOT ACTUALLY GET CORE; IT MERELY RESERVES
;;; ADDRESS SPACE.
;;; THERE IS CURRENTLY NO PROVISION FOR RETURNING THE MEMORY GRABBED.

GETCOR:	HLLOS NOQUIT
	LSH TT,PAGLOG
	MOVE T,HINXM
	SUBI T,(TT)
	CAMGE T,BPSH
	 JRST GTCOR6
20$	PUSH P,B
	MOVEI F,(TT)		;GETTING F THIS WAY FLUSHES
	LSH F,-PAGLOG		; RANDOM BITS. (IT'S SAFER.)
GTCOR4:	
	PUSHJ P,ALIMPG
	 .VALUE			;HOW CAN WE LOSE HERE?
	SOJG F,GTCOR4
20$	POP P,B
	SKIPA TT,HINXM
GTCOR6:	 TDZA TT,TT		;LOSE, LOSE, LOSE
	  ADDI TT,1
	JRST CZECHI



LHVB0:	WTA [BAD SIZE - LH↑<!]	;↑< = |
LHVBAR:	CAIL B,QLIST		;SUBR 2
	 CAILE B,QARRAY		;GROSS KLUDGE FOR LH
	  JRST LHVB1
	JSP T,FXNV1
	TLNE TT,-1
	 JRST LHVB0
	ADDI TT,PAGSIZ-1
	IDIVI TT,PAGSIZ
	MOVNI AR2A,(TT)
	PUSHJ P,GETCOR
	JUMPE TT,FIX1
	CAIE B,QARRAY
	 CAIN B,QRANDOM
	  XORI B,QARRAY#QRANDOM	;GROSS KLUDGE
	MOVEI D,(TT)
	LSH D,-SEGLOG
	IMULI AR2A,SGS%PG
	HRLI D,(AR2A)
   2DIF [MOVE R,(B)]GCWORS,QLIST
LHVB3:	MOVEM R,ST(D)
	SETZM GCST(D)
	TLNN R,$FS+BN+HNK
	 JRST LHVB4
	MOVE T,LHSGLK
	DPB T,[SEGBYT,,GCST(D)]
	HRRZM D,LHSGLK
LHVB4:	AOBJN D,LHVB3
	JRST FIX1

LHVB1:	EXCH A,B
	WTA [BAD SPACE - LH↑<!]	;↑< = |
	EXCH A,B
	JRST LHVBAR


;;;	IFN PAGING

SUBTTL	PDL OVERFLOW HANDLER

;;; CALL BY  JSR PDLSTH
;;; F HAS THE ADDRESS OF THE AC HOLDING THE PDL POINTER.
;;; D HAS AN ADDRESS WITHIN THE PAGE TO GET.
;;; R MAY BE USED AS SCRATCH.

;PDLSTH:	0		;HACK ST FOR ADDING PDL PAGES
PDLST0:
	LSH D,-PAGLOG
IFN ITS,[
	.CALL PDLST8
	 .LOSE 1000
]		;END OF IFN ITS
IFN D20,[
	MOVEM A,PDLSTA		;SAVE AWAY AC'S SO CAN DO A JSYS
	MOVEM B,PDLSTB
	MOVEM C,PDLSTC
	MOVEI 1,.FHSLF		;DISABLE INTERRUPT FOR OURSELVES
	MOVE 2,[<1←<35.-.ICNXP>>] ;WE CAN'T HANDLE THE NXP TRAP THIS WILL CAUSE
	DIC
	MOVEI 1,(D)		;PAGE NUMBER
	LSH 1,PAGLOG		;MAKE AN ADDRESS
	SETMM (1)		;CREATE THE PAGE
	MOVSI 1,.FHSLF		;CHANGE ACCESS FOR OUR PROCESS
	HRRI 1,(D)		;THE PAGE WE JUST CREATED
	MOVSI 2,(PA%RD\PA%WT\PA%EX)
	SPACS
	MOVEI 1,.FHSLF		;REEANBLE NXP TRAPS
	MOVE 2,[<1←<35.-.ICNXP>>]
	AIC
	MOVE C,PDLSTC		;RESTORE AC'S
	MOVE B,PDLSTB
	MOVE A,PDLSTA
]		;END OF IFN D20
	MOVEI R,(D)		;CALCULATE PURTBL BYTE POINTER
	ROT R,-4
	ADDI R,(R)
	ROT R,-1
	TLC R,770000
	ADD R,[430200,,PURTBL]
	MOVSS D
	HRRI D,3
	DPB D,R				;UPDATE PURTBL
	LSH D,-22+PAGLOG-SEGLOG		;HORRIBLE HACKERY TO UPDATE ST
	ADD D,[-<SGS%PG+1>,,ST-1]	; WITHOUT AN EXTRA AC:
REPEAT SGS%PG, PUSH D,PDLST9-P(F)	; USE PUSHES! (CAN'T OVERFLOW)
	JRST @PDLSTH

IFN ITS,[
PDLST8:	SETZ
	SIXBIT \CORBLK\		;HACK PAGE MAP
	  1000,,%CBNDR+%CBNDW	;GET READ AND WRITE ACCESS
	  1000,,%JSELF		;FOR MYSELF
	      ,,D		;PAGE NUMBER
	401000,,%JSNEW		;GET FRESH PAGE
]		;END OF IFN ITS

;;;	IFN PAGING


;;; HAIRY PDL OVERFLOW HANDLER

PDLOV:	MOVE F,INTPDL
	MOVEM D,IPSWD2(F)	;SAVE D
	MOVEM R,IPSWD1(F)	;SAVE R
	SKIPL INTPDL
	 .VALUE			;I WANT TO SEE THIS! - GLS
	MOVEI F,P		;ALL RIGHT THEN, LET'S PLAY
	JUMPGE P,PDLH0A		; TWENTY QUESTIONS - IS IT REGPDL?
	MOVEI F,SP
	JUMPGE SP,PDLH0A	;SPECPDL?
	MOVEI F,FXP
	JUMPGE FXP,PDLH0A	;FXP?
	MOVEI F,FLP		;IF NOT FLP, THEN IT'S PRETTY RANDOM
	JUMPGE FLP,PDLH0A
	HLRZ R,NOQUIT
	JUMPN R,PDLH3A
	LERR [SIXBIT \RANDOM PDL OVERFLOW!\]

PDLH0A:	HRRZ R,(F)		;FETCH RIGHT HALF OF PDL POINTER
	MOVEI D,(R)
	CAML R,OC2-P(F)		;IF WE'RE OVER THE ORIGIN OF THE
	 JRST PDLH5		; OVERFLOW PDL, THEN ERROR OUT
	HLRZ R,F
	ADDI R,11(D)		;HERE IS A HACK TO PAGIFY
	IORI R,PAGSIZ-1		; UPWARDS, BUT KEEP WELL AWAY
	SUBI R,10		; FROM THE PAGE BOUNDARY
	CAML R,OC2-P(F)		;IF WE'RE ABOVE THE OVERFLOW PDL,
	 MOVE R,OC2-P(F)	; ONLY INCREASE TO THAT PLACE
	CAMGE D,ZPDL-P(F)	;SKIP IF WE'RE ABOVE PDLMAX
	 JRST PDLH2		; PARAMETER FOR THIS PDL
	TLO F,-1		;SET FLAG TO INDICATE THIS FACT
	MOVE D,MORPDL-P(F)	;PUSH UP THE PDLMAX
	ADD D,ZPDL-P(F)		; "SOME MORE"
	ANDI D,777760		;BUT KEEP AWAY FROM PAGE
	TRNN D,PAGKSM		; BOUNDARY (PICKY, PICKY!)
	 SUBI D,20
	MOVEM D,ZPDL-P(F)
	HRRZ D,(F)
	JRST PDLH2A

PDLH2:	TLZE F,-1
	 JRST PDLH2B
	CAMLE R,ZPDL-P(F)	;IF OUR GUESS WOULD PUT US OVER
PDLH2A:	 MOVE R,ZPDL-P(F)	; PDLMAX, GO ONLY AS FAR AS THAT
PDLH2B:	SUBI D,(R)		;CALCULATE NEW LEFT HALF FOR PDL PTR
	HRLM D,(F)		;CLOBBER INTO PDL PTR
	HRRZ D,(F)		;FIGURE OUT IF WE NEED TOP GET
	ADDI R,10		; MORE CORE FOR ALL THIS
	ANDI R,PAGMSK
	EXCH R,D
	CAIG R,(D)		;SKIP IF WE CROSSED NO PAGE BOUNDARY
	 JSR PDLSTH		;ELSE MUST GET NEW PAGE AND UPDATE ST
	TLZN F,-1		;SKIP IF WE WERE ABOVE PDLMAX
	 JRST PDLH3A
	MOVSI D,QREGPDL-P(F)
	HRRI D,1005		;PDL-OVERFLOW
	HRRZ R,INTPDL
	HRRZ R,IPSPC(R)
	CAIL R,UINT0		;AVOID DEEP INTERRUPT RECURSION:
	 CAILE R,EUINT0		; IF PDL OVERFLOWED WITHIN UINT0,
	  JRST PDLH4		; THEN JUST STACK UP THE INTERRUPT,
	JSR UISTAK		; AND SOMEONE WILL EVENTUALLY TRY CHECKI
PDLH3A:	HRRZ F,INTPDL
	JRST INTXT2


PDLH4:	MOVE R,FXP		;ELSE TRY TO GIVE A PDL OVERFLOW
	SKIPE GCFXP		; USER INTERRUPT IMMEDIATELY
	 MOVE FXP,GCFXP		;REMEMBER, PDL OVERFLOW IS NOT
	PUSH FXP,R		; DISABLED INSIDE THE PDL
	PUSHJ FXP,$IWAIT	; OVERFLOW HANDLER!!!
	 JRST XUINT
	JRST INTXIT
	

;;;	IFN PAGING

MORPDL:	400		;AMOUNTS TO INCREMENT PDLS BY
	100		; WHEN OVERFLOW OCCURS (THIS GIVES
	LSWS+100	; LOSER A CHANCE TO SSTATUS PDLMAX,
	200		; AT LEAST)

PDLMSG:	POVPDL		;REG
	POVFLP		;FLONUM
	POVFXP		;FIXNUM
	POVSPDL		;SPEC

PDLST9:	$XM,,QRANDOM		;TYPICAL ST ENTRIES FOR PDL PAGES
	FL+$PDLNM,,QFLONUM
	FX+$PDLNM,,QFIXNUM
	$XM,,QRANDOM

PDLH5:	IORI R,PAGSIZ-1		;BAD PDL OV - REALLY DESPERATE
	SUBI D,-2(R)		;GIVE US AS MUCH PDL AS IS LEFT
	JUMPL D,PDLH6
	MOVE P,C2
	MOVE FXP,FXC2
	SETZM TTYOFF
	STRT UNRECOV
	STRT @PDLMSG-P(F)
	JRST DIE

PDLH6:	HRLM D,(F)
	HLRZ R,NOQUIT
	JUMPN R,GCPDLOV		;FOO! HAPPENED IN GC - BOMB OUT!
	HRRZ B,PDLMSG-P(F)
	CAIE B,POVSPDL
	JRST PDLOV5		;PDLOV5 HANDLE WILL GET US TO TOP LEVEL
	MOVEM P,F		;FOR SP, TRY TO POP BINDINGS FIRST
	HRRZ TT,SPSV		; SO *RSET-TRAP WON'T OVERFLOW
	MOVE P,[-LFAKP-1,,FAKP]	;SO WE HAVE ENOUGH PDL FOR UBD
	PUSH P,FXP
	MOVE FXP,[-LFAKFXP-1,,FAKFXP]
	PUSHJ P,UBD
	POP P,FXP
	MOVE P,F
	JRST PDLOV5		;PDLOV5 WILL SET UP PDLS

]		;END OF IFN PAGING

SUBTTL	PURE SEGMENT CONSER

;;; GRBPSG RETURNS ONE PUREIFIABLE SEGMENT.  ADR IN AC T
;;; GTNPSG IS INVOKED AS FOLLOWS:
;;;		AOSL A,NPFF%	;SKIP UNLESS NO MORE LEFT
;;;	   SPECPRO INTPPC
;;;		PUSHJ P,GTNPSG	;MUST GET MORE
;;;		ADD A,EPFF%	;ELSE JUST FIGURE OUT ABSOLUTE ADDRESS
;;;	   NOPRO
;;; WHERE % IS SOME APPROPRIATE LETTER (E.G. S, X, L, B).
;;; GTNPSG UPDATES NPFF% AND EPFF% BY LOOKING AT THE AOSL, THEN
;;; RETURNS TO THE AOSL.

   XCTPRO
GRBPSG:	HLLOS NOQUIT		;GET NEW PURE SEGMENT
   NOPRO
	SOVEFX TT D R
	SKIPN T,PRSGLK		;SKIP IF ANY SEGMENTS IN PURE SEGMENT FREELIST
	 PUSHJ P,GTNPS3
	LDB D,[SEGBYT,,GCST(T)]	;IF SO, CDR THAT FREELIST
	MOVEM D,PRSGLK
	MOVE TT,[$XM+PUR,,QRANDOM]
	MOVEM TT,ST(T)		;SETUP ST TABLE CORRECTLY
	SETZM GCST(T)		;AND ALSO GCST
	RSTRFX R D TT
	JRST CZECHI

;GETS A PURE SEGMENT FOR CONSING PURPOSES
   XCTPRO
GTNPSG:	HLLOS NOQUIT		;GET NEW PURE SEGMENT
   NOPRO
REPEAT 2,	SOS (P)		;BACK UP RETURN ADDRESS TO PRECEDING INST
	SOVEFX T TT D R
	SKIPN T,PRSGLK		;SKIP IF ANY SEGMENTS IN PURE SEGMENT FREELIST
	 PUSHJ P,GTNPS3
	LDB D,[SEGBYT,,GCST(T)]	;IF SO, CDR THAT FREELIST
	MOVEM D,PRSGLK
IFE HNKLOG,	MOVE D,@(P)	;NOW D POINTS TO NPFF-
IFN HNKLOG,[
	MOVE D,(P)		;THIS ALLOWS REFERENCE TO NPFF- TO BE INDEXED
	MOVEI D,@(D)		; BY TT, WHICH MUST BE SAFE TO THIS POINT
]		;END OF IFN HNKLOG
   2DIF [SKIPN TT,(D)]GTNPS8,NPFFS
	 .VALUE
	MOVEM TT,ST(T)
	SETZM GCST(T)
	LSH T,SEGLOG
	ADDI T,SEGSIZ
	MOVEM T,EPFFS-NPFFS(D)	;UPDATE PARAMETERS FOR NEW PURE SEGMENT
	MOVNI T,SEGSIZ+1
	MOVEM T,(D)
	MOVEI T,SEGSIZ
	ADDM T,PFSSIZ-NPFFS(D)	;UPDATE STORAGE SIZE
	RSTRFX R D TT T
	JRST CZECHI

;;; TYPICAL ST ENTRIES FOR PURE SEGMENTS
GTNPS8:	LS+$FS+PUR,,QLIST		;LIST
	FX+PUR,,QFIXNUM			;FIXNUM
	FL+PUR,,QFLONUM			;FLONUM
DB$	DB+PUR,,QDOUBLE			;DOUBLE
CX$	CX+PUR,,QCOMPLEX		;COMPLEX
DX$	DX+PUR,,QDUPLEX			;DUPLEX
BG$	BN+PUR,,QBIGNUM			;BIGNUM
	0				;NO PURE SYMBOLS
HN$  REPEAT HNKLOG+1,  LS+HNK+PUR,,QHUNK0+.RPCNT 	;HUNKS
	0				;NO PURE SARS
IFN .-GTNPS8-NFF, WARN [GTNPS8 WRONG LENGTH TABLE]
	$XM+PUR,,QRANDOM		;SYMBOL BLOCKS

;CALLED TO GET NEW PAGE OF PURE MEMORY
;RETURNS C(PRSGLK) IN T
GTNPS3:	PUSH FXP,TT		;GTNPSG REQUIRES TT TO BE SAFE
IFN PAGING,[
	MOVE T,HINXM		;FIGURE OUT IF ANY ROOM LEFT
	SUBI T,PAGSIZ
	CAMGE T,BPSH
	 LERR [SIXBIT \NO SPACE FOR NEW PURE PAGE!\]
	MOVEM T,HINXM		;UPDATE HINXM
	MOVEI TT,1(T)
]		;END OF IFN PAGING
IFE PAGING,[
	MOVE TT,HIXM
	ADDI TT,PAGSIZ
	CAMLE TT,MAXNXM
	 LERR [SIXBIT \NO SPACE FOR NEW PURE PAGE!\]
	MOVEM TT,HIXM
]		;END OF IFE PAGING
	LSH TT,-SEGLOG		;UPDATE ST AND GCST FOR NEW PAGE
	MOVE D,[$XM+PUR,,QRANDOM]
REPEAT SGS%PG, MOVEM D,ST+.RPCNT(TT)
	MOVE D,PRSGLK
REPEAT SGS%PG,[
	SETZM GCST+.RPCNT(TT)
	DPB D,[SEGBYT,,GCST+.RPCNT(TT)]
	MOVEI D,.RPCNT(TT)
]		;END OF REPEAT SGS%PG
	MOVEM D,PRSGLK
IFN PAGING,[
	MOVEI TT,1(T)		;UPDATE PURTBL
	ROT TT,-PAGLOG-4
	ADDI TT,(TT)
	ROT TT,-1
	TLC TT,770000
	ADD TT,[430200,,PURTBL]
	DPB T,TT		;T HAS 11 IN LOW TWO BITS
				; (CAN PURIFY, WITH SOME CARE)
IFN ITS,[
	MOVEI R,1(T)		;NOT AN AOBJN POINTER,
	LSH R,-PAGLOG		; SO WE GET ONLY ONE PAGE
	.CALL GTSPC8
	 .LOSE 1000
]		;END OF IFN ITS
IFN D20,[
	PUSHJ FXP,SAV3
	SETMM 1(T)		;CREATE THE PAGE
	MOVEI 1,1(T)		;THEN GET THE PAGE NUMBER
	LSH 1,-PAGLOG
	HRLI 1,.FHSLF
	MOVSI 2,(PA%RD\PA%WT\PA%EX)
	SPACS
	PUSHJ FXP,RST3
]		;END OF IFN D20
]		;END OF IFN PAGING
IFN <PAGING-1>*D10,[
	HRRZ TT,HIXM
	CORE TT,
	 HALT
]		;END OF IFN <PAGING-1>*D10
	MOVE T,PRSGLK		;FORCE PRSGLK INTO AC T FOR CALLER
	POP FXP,TT
	POPJ P,


SUBTTL	FREE STORAGE SPACE EXPANSION

;;; THIS PORTION OF THE GARBAGE COLLECTOR DETERMINES WHETHER
;;; WE SHOULD JUST GRAB A NEW SEGMENT OF FREE STORAGE FOR SOME
;;; CONSER, OR DO A FULL-BLOWN GARBAGE COLLECTION. IT IS
;;; CONTROLLED BY PARAMETERS SETTABLE VIA (SSTATUS GCSIZE ...).

GCGRAB:	MOVN R,D
	JFFO R,.+1		;DETERMINE WHICH SPACE WANTED MORE
	SUBI F,NFF
	MOVEI AR2A,1		;MACRAK SEZ: GRAB JUST ONE
	SKIPN FFY2
	 SETZ F,
	JUMPE F,GCGRB1		; ... SEZ MACRAK
	MOVE D,SFSSIZ+NFF(F)
	CAML D,GFSSIZ+NFF(F)	;CAN'T JUST GRAB IF ABOVE SIZE
	 JRST AGC1Q		; SPECIFIED FOR "FREE GRABBIES"
	MOVE D,GFSSIZ+NFF(F)
	CAMLE D,XFFS+NFF(F)	;CAN'T GRAB IF IT WOULD PUT
	 JRST AGC1Q		; US ABOVE THE MAXIMUM SIZE
GCGRB1:	PUSH FXP,AR2A
	PUSHJ P,GRABWORRY
	POP FXP,AR1
	JUMPGE AR2A,AGC1Q	;GO DO FULL-BLOWN GC AFTER ALL
IFN WHL,[
	MOVE D,[-3,,GCWHL6]
	MOVE R,GCWHO
	TRNE R,1
	 .SUSET D
]		;END OF IFN WHL
	JRST GCEND

;;; THESE ROUTINES WORRY ABOUT GETTING A NEW IMPURE FREE STORAGE
;;; SEGMENT. (FOR PURE FREE STORAGE SEGMENTS, SEE GTNPSG.)
;;; GCWORRY MUST DO SPECIAL HACKERY FOR SYMBOL AND SAR SPACES, SINCE THEY
;;; REQUIRE MORE THAN ONE CONSECUTIVE SEGMENT, AND PRINTS OUT PRETTY
;;; MESSAGES IF GCGAG IS NON-NIL.  MUST HAVE NOQUIT NON-ZERO.
;;; *THE FOLLOWING COMMENT IS HISTORICAL AND SHOULD BE IGNORED*
;;; MUST HAVE NOQUIT NON-ZERO AND ST/GCST PAGES IMPURE WHEN ENTERING!

;THIS ROUTINE ALLOCATES ONE IMPURE SEGMENT AND MARKS IT AS
; $XM,,QRANDOM IN ST TABLE.  POINTER TO SEGMENT RETURNED IN TT
; DESTROYS C, D, AR1, R
GRBSEG:	SKIPE TT,IMSGLK
	 JRST GRBSG1		;JUMP IF ANY SEGMENTS AVAILABLE
	PUSHJ P,ALIMPG		;ELSE MUST GRAB A NEW PAGE
	 POPJ P,		;FAIL IF NO NEW PAGES TO BE HAD
GRBSG1:	LDB D,[SEGBYT,,GCST(TT)]
	MOVEM D,IMSGLK		;CDR THE FREE SEGMENT LIST
	MOVE D,[$XM,,QRANDOM]	;MARK NEW SEGMENT IN ST TABLE
	MOVEM D,ST(TT)
	SETZM GCST(TT)		;RESET GCST TABLE ENTRY
	LSH TT,SEGLOG		;RETURN A POINTER TO THE HEAD OF THE SEGMENT
	AOS (P)
	POPJ P,

;THIS ROUTINE IS FOR NORMAL ALLOCATION OF SEGMENTS BY THE GC
GCWORRY:SUBI AR2A,(TT)		;ENTRY FOR GARBAGE COLLECTOR
	ADDI AR2A,SEGSIZ-1	;FIGURE OUT HOW MANY NEW SEGMENTS WE NEED
	LSH AR2A,-SEGLOG
GRABWORRY:
	HRRZ AR1,VMSGFILES
	TLO AR1,200000
	JUMPE F,.+2	;ENTRY FOR GCGRAB
	SKIPN GCGAGV		;MAYBE WE WANT A PRETTY MESSAGE?
	 SOJA AR2A,GCWOR2	;IF NOT, DECR AR2A (SEE BELOW)
	STRT 17,[SIXBIT \↑M;ADDING !\]
	SOJG AR2A,GCWR0A	;AR2A GETS DECR'ED HERE, TOO!
	STRT 17,[SIXBIT \A!\]	;KEEP THE ENGLISH GOOD
	JRST GCWR0B

GCWR0A:	MOVEI R,$TYO
	MOVEI TT,1(AR2A)
	PUSH FXP,AR2A
IFE USELESS,	MOVE C,@VBASE		;BASE DAMN WELL BETTER BE A FIXNUM
IFN USELESS,[
	HRRZ C,VBASE
	CAIE C,QROMAN
	 SKIPA C,(C)
	  PUSHJ P,PROMAN
]		;END OF IFN USELESS
	   PUSHJ P,PRINI9
	POP FXP,AR2A
GCWR0B:	STRT 17,[SIXBIT \ NEW !\]
	STRT 17,@GSTRT9+NFF(F)
	STRT 17,[SIXBIT \ SEGMENT!\]
	SKIPE AR2A
	 STRT 17,[SIXBIT \S!\]
GCWOR2:	SKIPE TT,IMSGLK
	 JRST GCWR2A		;JUMP IF ANY SEGMENTS AVAILABLE
	PUSHJ P,ALIMPG		;ELSE MUST GRAB A NEW PAGE
	 JRST GCWOR7
GCWR2A:	LDB D,[SEGBYT,,GCST(TT)]
	MOVEM D,IMSGLK		;CDR THE FREE SEGMENT LIST
	MOVE D,FSSGLK+NFF(F)	;CONS NEW SEGMENT ONTO LIST
	MOVEM TT,FSSGLK+NFF(F)	; OF SEGMENTS FOR THE
	HRRZ R,BTBAOB		; PARTICULAR SPACE
	HLL R,GCWORS+NFF(F)
	LSH D,22-<SEGLOG-5>
GCWR2B:	TLNE R,$FS+FX+FL+BN+HNK+DB+CX+DX	.SEE GCWR2C
	 IORI D,(R)		;MAYBE ALLOCATE A BIT BLOCK FOR
	IOR D,GCWORG+NFF(F)	; THE NEW SEGMENT FOR USE BY
	MOVEM D,GCST(TT)	; GC IN MARKING CELLS
	MOVE D,GCWORS+NFF(F)	;UPDATE ST ENTRY FOR THE
	MOVEM D,ST(TT)		; NEW SEGMENT
	MOVE D,FFS+NFF(F)	;ADD CELLS OF SEGMENT TO
	LSH TT,SEGLOG		; THE FREE STORAGE
	MOVEM D,(TT)		; LIST FOR THIS SPACE
	MOVE D,[GCWORX,,1]
	BLT D,LPROG9
	HLL TT,GCWORN+NFF(F)
	HRR GCWRX1,GCWORN+NFF(F)
	HRRI GCWRX2,-1(GCWRX1)
	JRST GCWRX1

GCWR2C:	HRRZM TT,FFS+NFF(F)
	TLNN R,$FS+FX+FL+BN+HNK+DB+CX+DX	.SEE GCWR2B
	 JRST GCWR4Q
	HRRZ TT,BTBAOB		;DECIDE WHETHER THIS BIT BLOCK
	LSH TT,SEGLOG-5		; LIES IN MAIN BIT BLOCK AREA
	MOVEI D,-1(TT)
	CAME D,MAINBITBLT
	 JRST GCWR3A
	ADDI D,BTBSIZ		;YES - JUST UPDATE MAIN BLT
	MOVEM D,MAINBITBLT	; POINTER FOR CLEARING 
	JRST GCWR3B		; BIT BLOCKS (SEE GCINBT)

GCWR3A:	LSH TT,-SEGLOG		;ELSE AOS COUNT OF BIT BLOCKS
	AOS GCST(TT)		; IN CURRENT BIT BLOCK SEGMENT
GCWR3B:	MOVE TT,BTBAOB		;AOBJN THE BIT BLOCK
	AOBJN TT,GCWOR4		; ALLOCATION POINTER
	SKIPE TT,IMSGLK		;FOO! OUT OF BIT BLOCKS!
	 JRST GCWR3F
	PUSHJ P,ALIMPG		;FOO FOO! NEED NEW PAGE!
	 JRST GCWFOO
GCWR3F:	LDB D,[SEGBYT,,GCST(TT)]
	MOVEM D,IMSGLK		;CDR LIST OF FREE SEGMENTS
	MOVE D,[$XM,,QRANDOM]	;UPDATE ST AND GCST FOR
	MOVEM D,ST(TT)		; NEW BIT BLOCK SEGMENT
	MOVEI D,(TT)		;GCST ENTRY IS USED TO
	LSH D,5			; INDICATE HOW MANY
	MOVEM D,GCST(TT)	; BLOCKS ARE IN USE
	MOVE D,BTSGLK		;CONS NEW SEGMENT ONTO LIST
	DPB D,[SEGBYT,,GCST(TT)]	; OF BIT BLOCK SEGMENTS
	MOVEM TT,BTSGLK
	LSH TT,5		;CALCULATE NEW BIT BLOCK
	HRLI TT,-SEGSIZ/BTBSIZ	; ALLOCATION POINTER
GCWOR4:	MOVEM TT,BTBAOB
GCWR4Q:	JUMPE F,GCWOR6
	MOVEI TT,SEGSIZ		;UPDATE VARIOUS GC PARAMETERS
	ADDM TT,NFFS+NFF(F)
	ADDB TT,SFSSIZ+NFF(F)
	CAMLE TT,XFFS+NFF(F)	;MUST STOP IF OVER MAX
	 SOJA AR2A,.+2		;KEEP COUNT ACCURATE
GCWOR6:	SOJGE AR2A,GCWOR2	;ALSO STOP IF WE GOT ALL WE WANT
GCWOR7:	JUMPE F,CPOPJ
	SKIPN GCGAGV		;MAYBE WANT MORE PRETTY MESSAGE
	 POPJ P,
	SKIPL AR2A
	 STRT 17,[SIXBIT \↑M; BUT DIDN'T SUCCEED!\]
	STRT 17,[SIXBIT \ -- !\]
	STRT 17,@GSTRT9+NFF(F)
	STRT 17,[SIXBIT \ SPACE NOW !\]
	MOVEI R,$TYO
	PUSH FXP,AR2A
	HRRZ AR1,VMSGFILES
	TLO AR1,200000
	MOVE TT,SFSSIZ+NFF(F)
IFE USELESS,	MOVE C,@VBASE
IFN USELESS,[
	HRRZ C,VBASE
	CAIE C,QROMAN
	 SKIPA C,(C)
	  PUSHJ P,PROMAN
]		;END OF IFN USELESS
	   PUSHJ P,PRINI9
	STRT 17,[SIXBIT \ WORDS!\]
	POP FXP,AR2A
	POPJ P,

;;; TYPICAL GCST ENTRIES FOR IMPURE SPACES
GCWORG:	GCBMRK+GCBCDR+GCBCAR,,			;LIST
	GCBMRK,,				;FIXNUM
	GCBMRK,,				;FLONUM
DB$	GCBMRK,,				;DOUBLE
CX$	GCBMRK,,				;COMPLEX
DX$	GCBMRK,,				;DUPLEX
BG$	GCBMRK+GCBCDR,,				;BIGNUM
	GCBMRK+GCBSYM,,				;SYMBOL
HN$  REPEAT HNKLOG+1, GCBMRK+GCBCDR+GCBCAR+GCBHNK,,	;HUNKS
	GCBMRK+GCBSAR,,				;SAR
IFN .-GCWORG-NFF, WARN [WRONG LENGTH TABLE]
	0					;SYMBOL BLOCKS

;;; TYPICAL ST ENTRIES FOR IMPURE SPACES
GCWORS:	LS+$FS,,QLIST				;LISP
	FX,,QFIXNUM				;FIXNUM
	FL,,QFLONUM				;FLONUM
DB$	DB,,QDOUBLE				;DOUBLE
CX$	CX,,QCOMPLEX				;COMPLEX
DX$	DX,,QDUPLEX				;DUPLEX
BG$	BN,,QBIGNUM				;BIGNUM
	SY,,QSYMBOL				;SYMBOL
HN$  REPEAT HNKLOG+1, LS+HNK,,QHUNK0+.RPCNT		;HUNKS
	SA+$XM,,QARRAY				;SAR
IFN .-GCWORS-NFF, WARN [WRONG LENGTH TABLE]
	$XM,,QRANDOM				;SYMBOL BLOCKS

GCWFOO:	STRT [SIXBIT \↑M;GLEEP#! OUT OF BIT BLOCKS!\]
	JRST GCWOR7

GCWORX:			;EXTEND FREELIST THROUGH NEW SEGMENT
OFFSET 1-.
GCWRX1:	HRRZM TT,.(TT)	;OCCUPIES A,B,C,AR1 - MUST SAVE AR2A
GCWRX2:	ADDI TT,.
	AOBJN TT,GCWRX1
	JRST GCWR2C
LPROG9==:.-1
OFFSET 0
.HKILL GCWRX1 GCWRX2

GCWORN:	-SEGSIZ+1,,1				;LIST
	-SEGSIZ+1,,1				;FIXNUM
	-SEGSIZ+1,,1				;FLONUM
DB$	-SEGSIZ/2+1,,2				;DOUBLE
CX$	-SEGSIZ/2+1,,2				;COMPLEX
DX$	-SEGSIZ/2+1,,4				;DUPLEX
BG$	-SEGSIZ+1,,1				;BIGNUM
	-SEGSIZ+1,,1				;SYMBOL
HN$ 	REPEAT HNKLOG+1, -SEGSIZ/<1←.RPCNT>+1,,1←.RPCNT	;HUNKS
	-SEGSIZ/2+1,,2				;ARRAY SARS
IFN .-GCWORN-NFF, WARN [WRONG LENGTH TABLE]
	-SEGSIZ/2+1,,2				;SYMBOL BLOCKS

SUBTTL	IMPURE PAGE GOBBLER

;;; ALLOCATE AN IMPURE PAGE FREE STORAGE USE

ALIMPG:
IFN PAGING,[
	MOVE TT,HINXM		;MUST SAVE AR2A AND F FOR GCWORRY
	SUBI TT,PAGSIZ
	CAMGE TT,BPSH
]		;END OF IFN PAGING
IFE PAGING,[
	MOVE TT,HIXM
	ADDI TT,PAGSIZ
	CAMLE TT,MAXNXM
]		;END OF IFE PAGING
	 POPJ P,		;NO PAGES LEFT - RETURN WITHOUT SKIP
IFN PAGING,[
	MOVEM TT,HINXM		;ELSE UPDATE HINXM
IFN ITS,[
	MOVEI R,1(TT)
	LSH R,-PAGLOG
	.CALL GTSPC8
	 .LOSE 1000
]		;END OF IFN ITS
IFN D20,[
	SETMM 1(TT)		;CREATE THE PAGE
	MOVEI 1,1(TT)
	LSH 1,-PAGLOG
	HRLI 1,.FHSLF
	MOVSI 2,(PA%RD\PA%WT\PA%EX)
	SPACS
]		;END OF IFN D20
	MOVEI D,1(TT)		;COMPUTE A MAGIC BYTE POINTER
	LSH D,-PAGLOG
	ROT D,-4
	ADDI D,(D)
	ROT D,-1
	TLC D,770000
	ADD D,[430200,,PURTBL]
	MOVEI C,1
	DPB C,D			;UPDATE THE PURTBL
	HRRZ R,(P)		;GET THE CALLER'S PC+1
	CAIN R,GTCOR4+1		;DON'T HACK IMSGLK FOR GETCOR
	 JRST POPJ1
]		;END OF IFN PAGING
IFN <PAGING-1>*D10,[
	MOVEM TT,HIXM
	CORE TT,
	 HALT
	MOVE TT,HIXM
]		;END OF IFN <PAGING-1>*D10
	LSH TT,-SEGLOG
IFN PAGING, ADDI TT,SGS%PG
	MOVE C,IMSGLK		;UPDATE ST AND GCST, AND ADD
	MOVE AR1,[$XM,,QRANDOM]	; NEW SEGMENTS TO IMSGLK LIST
	MOVEI D,SGS%PG
ALIMP3:	MOVEM AR1,ST(TT)
	SETZM GCST(TT)
	DPB C,[SEGBYT,,GCST(TT)]
	MOVEI C,(TT)
	SOSE D
	 SOJA TT,ALIMP3
	MOVEM TT,IMSGLK		;EXITS WITH LOWEST NEW SEGMENT # IN TT
	JRST POPJ1		;WINNING RETURN SKIPS

SUBTTL	RECLAIM FUNCTION

IFN BIGNUM+USELESS,[

RECLAIM:	HRRZS A		;SUBR 2
	JUMPE A,CPOPJ		;GC A PARTICULAR SEXP
	LOCKI
	PUSHJ P,RECL1
	MOVEI A,NIL
	UNLKPOPJ


RECL1:	SKOTT A,LS+PUR
    2DIF JRST (TT),RECL9-1,QLIST	.SEE STDISP
	TLNE TT,HNK+VC+PUR	;DON'T RECLAIM VALUE CELLS!!! (OR HUNKS)
	 POPJ P,			; - ALSO DON'T RECLAIM PURE WORDS
	PUSH P,A		;SAVE ARG
	JUMPE B,RECL2		;B=NIL => RECLAIM ONLY TOP LEVEL OF LIST
	HLRZ A,(A)		;RECLAIM CAR
	PUSHJ P,RECL1
RECL2:	MOVE T,FFS
	POP P,FFS
	EXCH T,@FFS		;RECLAIM ONE CELL
	MOVEI A,(T)		;AND THEN GO AFTER THE CDR
	JRST RECL1

RECLFW:	JUMPE B,RECL9A		;B=NIL => DON'T RECLAIM FULLWORDS
	TLNE TT,$PDLNM		;DON'T RECLAIM PDL LOCATIONS!!!
	 POPJ P,
   2DIF [MOVE T,(TT)]FFS-QLIST	;RECLAIM NUMBER
	MOVEM T,(A)
   2DIF [MOVEM A,(TT)]FFS-QLIST
	POPJ P,

IFN BIGNUM,[
REBIG:	MOVE T,FFB		;RECLAIM BIGNUM HEADER
	EXCH T,(A)
	MOVEM A,FFB
	MOVEI A,(T)		;RECLAIM CDR OF BIGNUM
	JRST RECL1
]		;END OF IFN BIGNUM

RECL9:	JRST RECLFW	;FIXNUM
	JRST RECLFW	;FLONUM
DB$	JRST RECLFW	;DOUBLE
CX$	JRST RECLFW	;COMPLEX
DX$	JRST RECLFW	;DUPLEX
BG$	JRST REBIG	;BIGNUM
RECL9A:	POPJ P,		;SYMBOL
HN$  REPEAT HNKLOG+1, .VALUE	;HUNKS
	POPJ P,		;RANDOM
	POPJ P,		;ARRAY
IFN .-RECL9-NTYPES+1, WARN [WRONG LENGTH TABLE]

]		;END OF IFN BIGNUM+USELESS

IFN PAGING,[

SUBTTL	VALUE CELL AND SYMBOL BLOCK HACKERY

;;; ROUTINE TO GET MORE VALUE CELL SPACE.
;;; EXPANDS VALUE CELL SPACE BY GETTING NEXT PAGE IN THE HOLE
;;; LEFT FOR THIS PURPOSE, AND EXTENDING THE VALUE CELL FREELIST.
;;; IF NO PAGES LEFT IN THE HOLE, A LIST CELL IS USED.
;;; MAY CLOBBER ONLY A AND TT.

   XCTPRO
MAKVC3:	HLLOS NOQUIT
   NOPRO
	SOSL NFVCP
	 JRST MAKVC4
	PUSHJ P,CZECHI
	PUSHJ P,CONS1
	SETOM ETVCFLSP
	JRST MAKVC1

MAKVC4:
IFN ITS,[
	PUSH FXP,R		;MUST SAVE R
	MOVE R,EFVCS
	LSH R,-PAGLOG
	.CALL GTSPC8		;GET A NEW PAGE
	 .LOSE 10000
	POP FXP,R
]		;END OF IFN ITS	
IFN D20,[
	PUSHJ FXP,SAV3
	MOVE 1,EFVCS
	SETMM (1)		;CREATE THE PAGE
	LSH 1,-PAGLOG
	HRLI 1,.FHSLF
	MOVSI 2,(PA%RD\PA%WT\PA%EX)
	SPACS
	PUSHJ FXP,RST3
]		;END OF IFN D20
	MOVE A,EFVCS
	MOVEM A,FFVC
	LSH A,-SEGLOG
	MOVE TT,[LS+VC,,QLIST]
REPEAT SGS%PG, MOVEM TT,ST+.RPCNT(A)	;UPDATE SEGMENT TABLE
	MOVSI TT,GCBMRK+GCBVC
REPEAT SGS%PG, MOVEM TT,GCST+.RPCNT(A)	;UPDATE GC SEGMENT TABLE
	LSH A,-PAGLOG+SEGLOG		;UPDATE PURTBL
	ROT A,-4
	ADDI A,(A)
	ROT A,-1
	TLC A,770000
	ADD A,[430200,,PURTBL]
	MOVEI TT,1
	DPB TT,A
	AOS TT,EFVCS		;EXTEND FREELIST THROUGHOUT NEW PAGE
	HRLI TT,-PAGSIZ+1
	HRRZM TT,-1(TT)
	AOBJN TT,.-1
	HRRZM TT,EFVCS
MAKVC8:	PUSHJ P,CZECHI
	JRST MAKVC0

]		;END OF IFN PAGING


;;; SYMBOL BLOCK COPYING ROUTINE - TRIGGERED BY PURE PAGE TRAP, OR EXPLICIT CHECK
;;;	B POINTS TO OLD SYMBOL BLOCK
;;;	LEAVES POINTER TO NEW SYMBOL BLOCK IN B
;;;	CLOBBERS TT, LEAVES POINTER TO VALUE CELL IN A

LDPRG9:	TLCA B,LDPARG		;FASLOAD CLOBBERING ARGS PROP
ARGCL7:	TLC B,ARGCL3		;ARGS CLOBBERING ARGS PROP
	HRRZ A,(B)
	JRST MAKVC6

MAKVC9:	TLC B,MAKVCX		;MAKVC CLOBBERING IN VALUE CELL
	JRST MAKVC6
MAKVC5:	PUSH P,SPSV		;MUST PRESERVE SPSV AS WE CAN COME HERE FROM
				; WITHIN A BIND AND AGC DOES BINDING ALSO
	PUSHJ P,AGC
	POP P,SPSV
   BAKPRO
MAKVC6:	SKIPN FFY2		;COME HERE IF HRRM ABOVE CAUSES
	 JRST MAKVC5		; A PURE PAGE TRAP - MUST COPY
	MOVE TT,@FFY2		; SYMBOL BLOCK FOR THAT SYMBOL
   XCTPRO
	EXCH TT,FFY2
   NOPRO
	HRLI A,SY.ONE\SY.CCN\SY.OTC ;ASSUME COMPILED CODE NEEDS IT FOR OTHER
				; THEN CALL UUO'S
	MOVEM A,SYMVC(TT)	; (THINK ABOUT THIS SOME MORE)
	MOVE A,SYMPNAME(B)
	MOVEM A,SYMPNAME(TT)
	HRRZ A,(TT)
	HRLM TT,@(P)
	EXCH TT,B
	HLRZ TT,TT
	JRST (TT)



SUBTTL	ALLOC FUNCTION

$ALLOC:	CAIE A,TRUTH		;SUBR 1 - DYNAMIC ALLOC
	 JRST $ALLC5
	SETO F,			;ARG=T => MAKE UP LIST
	EXCH F,INHIBIT		;CROCKISH LOCKI - DOESN'T MUNG FXP
	MOVNI R,NFF
$ALLC6:	PUSH FXP,GFSSIZ+NFF(R)	;SAVE UP VALUABLE DATA
	PUSH FXP,XFFS+NFF(R)	;LOCKI KEEPS IT CONSISTENT
	PUSH FXP,MFFS+NFF(R)
	AOJL R,$ALLC6
IFN PAGING, REPEAT 4,	PUSH FXP,XPDL+.RPCNT
	MOVEM F,INHIBIT		;EQUALLY CROCKISH UNLOCKI
	PUSHJ P,CHECKI
	PUSH P,R70
IFN PAGING,[
	MOVEI R,4
$ALLC9:	POP FXP,TT
	SUB TT,C2-1(R)
	TLZ TT,-1
	JSP T,FIX1A
	MOVE B,(P)
	PUSHJ P,CONS
	MOVEI B,QREGPDL-1(R)
	PUSHJ P,XCONS
	MOVEM A,(P)
	SOJG R,$ALLC9
]		;END OF IFN PAGING
	MOVEI R,NFF
$ALLC7:	SKIPN SFSSIZ-1(R)
	 JRST $ALLC8		;SPACE SIZE IS ZERO - IGNORE IT
	POP FXP,TT
	PUSHJ P,SSGP2A
	PUSHJ P,NCONS
	MOVEI B,(A)
	POP FXP,TT
	JSP T,FIX1A
	PUSHJ P,CONS
	MOVEI B,(A)
	POP FXP,TT
	JSP T,FIX1A
	PUSHJ P,CONS
	MOVE B,(P)
	PUSHJ P,CONS
	MOVEI B,QLIST-1(R)
	CAIN B,QRANDOM
	 MOVEI B,QARRAY
	PUSHJ P,XCONS
	MOVEM A,(P)
	JRST $ALLC4

$ALLC8:	SUB FXP,R70+3		;FLUSH GARBAGE
$ALLC4:	SOJG R,$ALLC7
	JRST POPAJ


$ALLC0:	HRRZ A,(AR2A)
$ALLC5:	JUMPE A,TRUE		;DECODE LIST OF PAIRS
	HLRZ B,(A)		;ARG IS LIST OF SAME FORM AS
	HRRZ AR2A,(A)		; A .LISP. (INIT) COMMENT
	HLRZ C,(AR2A)
	CAIL B,QREGPDL
	 CAILE B,QSPECPDL
	  JRST $ALLC3
	MOVEI D,1←-1		;SSPDLMAX
	PUSHJ P,SSGP3$
	JRST $ALLC0

$ALLC3:	JSP R,SFRET
	 JRST $ALLC0
	 JRST $ALLC0
	SETZ AR1,
	MOVEI F,(C)
	SKOTT C,LS
	 JRST $ALLC2
	HRRZ AR1,(C)
	HLRZ C,(C)
	HLRZ F,(AR1)
	SKIPE AR1
	 SKIPA AR1,(AR1)
	  SKIPA F,C
	   HLRZ AR1,(AR1)
$ALLC2:	MOVEI D,3←-1		;SSGCSIZE
	PUSHJ P,SSGP3$
	MOVEI C,(F)
	MOVEI D,5←-1		;SSGCMAX
	PUSHJ P,SSGP3$
	MOVEI C,(AR1)
	MOVEI D,7←-1		;SSGCMIN
	PUSHJ P,SSGP3$
	JRST $ALLC0


	PGTOP BIB,[MEMORY MANAGEMENT STUFF]

βββ